2023年2月23日 / 最終更新日時 : 2024年4月17日 officeの杜 office

VBAからGmailを送りたくなったら

VBAやKintoneといったものからGMail経由でメールを送りたいという要望は今もまだ結構遭遇します。しかし、現在は通常この手の要望を実現するには、OAuth2.0認証を行ってAPI経由で送るというのがモダンな方法になっていて、SMTP直接送るというのがあまり推奨されていません。とは言え、VBAやkintoneからOAuth認証して送るというのはちょっとハードルが高い。

ということで、現在でも利用できるVBAからGMailに対してメールを送る手法をまとめてみました。

1 今回利用するファイル等
2 事前準備
- 2.1 二段階認証をオンにする
- 2.2 アプリパスワードを生成する
3 ソースコード
4 SMTPリレーサービス
5 関連リンク

今回利用するファイル等

VBAでGMailを送信する - Microsoft Excel

旧式の「安全性の低いアプリをオン」で送る手法は、ノーマルのGoogleアカウントでは2022年5月30日より廃止されています。GWSでは、2024年秋に停止になるようです。

事前準備

昔と違って、Google WorkspaceのSMTPに直接接続してVBAから送るといったことはセキュリティ上出来ません。また、大量に送るスパムなどでSMTPリレーが悪用されてきた事もあって、故にSMTP直接接続して連続送信というのは昨今は割と制限されていたりします。しかし、少量であるならば有用な手段ではあるので、VBAやkintoneで使うにはとっても有用です。其のためにはGoogle Workspace側でも設定が必要です。

二段階認証をオンにする

2021年10月より、通常のGoogleアカウントでは認証に「２段階認証」が強制されるようになっています。Google Workspaceはそうではない設定も使えるようですが、今どき２段階認証がオンにしていないケースなんてほぼ無いと思われますが、一応以下の手順で二段階認証をオンにすることが可能です。

Googleアカウントのセキュリティ項目にログインする
Googleへのログイン項目の「２段階認証プロセス」をクリック
オンにする（セキュリティキーやGoogle認証アプリなどでの処理を追加します）

図：二段階認証は今や常識です

アプリパスワードを生成する

SMTPを使ってメールを送るといっても、SMTP認証をGoogleアカウントのパスワードで送るのではなく、アプリパスワードと呼ばれるもので行うようになっているので、以下の手順でアプリパスワードを入手します。

Googleアカウントのセキュリティ項目にログインする
Googleへのログイン項目の「アプリパスワード」をクリック
アプリ選択では、メールを選択
デバイス選択では、Windowsパソコンを選択
生成ボタンを押す
16文字の文字列が出てくるのでこれを控えておく（この瞬間しか出ないので注意）

図：アプリパスワードを生成する

ソースコード

VBAからはCDO.messageを利用して送信します。kintoneの場合にはkmailerなどに設定して送ることになります。以下のサンプルはフル機能を使った場合のサンプルなので不要な項目は除外してコードを組み立てます。きちんと送信トレイにも残ります。

Public Function GmailSend2()
    'ファイルの存在有無チェック用
    Dim objFso As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")

    'アプリパスワードを設定
    Dim apppass as string
    apppass = "ここにアプリパスワードを入れる"

    '送信先設定
    Dim fromman As String
    Dim tomail As String
    Dim ccmail As String
    Dim bccmail As String
    
    fromman = "送信元アドレスを入れる"
    tomail = "送信先アドレスを入れる"
    ccmail = "ccの宛先を入れる"
    bccmail = "BCCの宛先を入れる"            '複数宛先はセミコロン区切り

    '送信タイトルとメッセージ本文
    Dim subject As String
    Dim bodyman As String
    
    subject = "テストメールだよ"
    bodyman = "このメールはテストです" & vbCrLf & vbCrLf & "返信しないでね"
    
    '添付ファイルの指定（複数の場合は配列にして格納する）
    Dim arrayman As Variant
    arrayman = "ここにファイルへのフルパスを入れる"
    
    'CDOにパラメータを与える
    With CreateObject("CDO.Message")
        '送信先指定
        .From = fromman
        .To = tomail
        .cc = ccmail
        .bcc = bccmail
        
        'タイトルと本文指定
        .subject = subject
        .textBody = bodyman        '.htmlbodyでHTMLメールを送れる
        
        '添付ファイルの指定（ここだけ指定方法がちょっと違う）
        '複数ファイルの場合は配列で渡す
        If IsArray(arrayman) = True Then
            For i = LBound(arrayman) To UBound(arrayman)
                '添付する
                If objFso.FileExists(arrayman(i)) Then
                    .AddAttachment arrayman(i)
                End If
            Next
        Else
            '---ファイルが存在してれば添付する
            If objFso.FileExists(arrayman) Then
                .AddAttachment arrayman
            End If
        End If
        
        '文字コードの指定
        .TextBodyPart.Charset = "ISO-2022-JP"
        
        '認証方法の指定
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            
            'SMTPサーバの指定
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
            
            'SSLの指定
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            
            'ユーザ名の指定
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = fromman
            
            'アプリパスワード
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =　apppass            
            '設定を保存
            .Update
        End With
        
        'エラートラップ
        On Error Resume Next
        'メールの送信
        .Send
        If Err.Number <> 0 Then
          MsgBox "エラー発生" & vbCrLf & "エラー番号：" & Err.Number & vbCrLf & "エラー内容：" & Err.Description, vbCritical + vbSystemModal
        End If
        On Error GoTo 0
    End With
    
    'オブジェクトを開放
    Set objMail = Nothing
    Set objFso = Nothing
    
    '終了メッセージ
    MsgBox "メール送信したよ"
    
End Function

100

101

Public Function GmailSend2()

'ファイルの存在有無チェック用

Dim objFso As Object

Set objFso = CreateObject("Scripting.FileSystemObject")

'アプリパスワードを設定

Dim apppass as string

apppass = "ここにアプリパスワードを入れる"

'送信先設定

Dim fromman As String

Dim tomail As String

Dim ccmail As String

Dim bccmail As String

fromman = "送信元アドレスを入れる"

tomail = "送信先アドレスを入れる"

ccmail = "ccの宛先を入れる"

bccmail = "BCCの宛先を入れる" '複数宛先はセミコロン区切り

'送信タイトルとメッセージ本文

Dim subject As String

Dim bodyman As String

subject = "テストメールだよ"

bodyman = "このメールはテストです" & vbCrLf & vbCrLf & "返信しないでね"

'添付ファイルの指定（複数の場合は配列にして格納する）

Dim arrayman As Variant

arrayman = "ここにファイルへのフルパスを入れる"

'CDOにパラメータを与える

With CreateObject("CDO.Message")

'送信先指定

.From = fromman

.To = tomail

.cc = ccmail

.bcc = bccmail

'タイトルと本文指定

.subject = subject

.textBody = bodyman '.htmlbodyでHTMLメールを送れる

'添付ファイルの指定（ここだけ指定方法がちょっと違う）

'複数ファイルの場合は配列で渡す

If IsArray(arrayman) = True Then

For i = LBound(arrayman) To UBound(arrayman)

'添付する

If objFso.FileExists(arrayman(i)) Then

.AddAttachment arrayman(i)

End If

Else

'---ファイルが存在してれば添付する

If objFso.FileExists(arrayman) Then

.AddAttachment arrayman

End If

'文字コードの指定

.TextBodyPart.Charset = "ISO-2022-JP"

'認証方法の指定

With .Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'SMTPサーバの指定

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

'SSLの指定

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'ユーザ名の指定

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = fromman

'アプリパスワード

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =　apppass

'設定を保存

.Update

End With

'エラートラップ

On Error Resume Next

'メールの送信

.Send

If Err.Number <> 0 Then

MsgBox "エラー発生" & vbCrLf & "エラー番号：" & Err.Number & vbCrLf & "エラー内容：" & Err.Description, vbCritical + vbSystemModal

End If

On Error GoTo 0

End With

'オブジェクトを開放

Set objMail = Nothing

Set objFso = Nothing

'終了メッセージ

MsgBox "メール送信したよ"

End Function

SMTPリレーサービス

概要

今回の手法の他に、Google Workspaceの場合にはSMTPリレーサービスというものも利用可能です。こちらはノーマルのGoogleアカウントでは設定が出来ません。こちらの場合送信先のSMTPアドレスは「smtp-relay.gmail.com」となります。

こちらは1 日に送信できるお客様あたりの合計の宛先数がユーザ数 ✕ 130の数となっています。

事前準備

Google WorkspaceのAdmin Consoleからルーティングを設定する必要があります。

Admin Consoleにログインする
アプリ→Google Workspace→Gmailを開く
ルーティングを開く
STMPリレーサービスの設定をクリック
許可する送信者は通常はドメイン内のアドレスを指定します。
指定したIPアドレスからのみメールを受信するを指定した場合にはIPアドレスレンジを指定する必要（CIDR）があります。IPv6形式での指定も可能です。
SMTP認証を必須にするをした場合、送信者側でも設定が必要です。この時のパスワードも前述の「アプリパスワード」である必要性があります。送信者のユーザ名はアプリパスワードを発行したユーザのメールアドレスになります。
7.をオンにした場合は通常はTLSによる暗号化を必須にするもチェックを入れます。
保存をクリックする

MailAppと違ってこの手法の場合、Fromのメールアドレスの書き換えが可能です。送信側がTLSに対応していない場合は、8.の設定は行いません（送信出来ずにエラーになる）

図：この画面でリレーサービス指定をする

送信側の指定

送信側でのポートの指定はSMTPリレーサービスの場合以下のようになる。

SMTPのポートはTLS有効化の場合は587となる
そうではない場合は、25, 465, 587のいずれかを指定する
TLSによる認証をしない場合、SMTP認証は出来ませんのでIPアドレス認証が必要になる

VBAからGmailを送りたくなったら

今回利用するファイル等