Office関連

CDOを使ってGmail送信を行うVBAマクロ

VBA Gmail 送信」といったキーワード検索で、「Gmail APIを使ってメール送信するVBAマクロ(3)」の記事にアクセスがありました。

たしかにGmail APIを使ってVBAマクロからメール送信することはできます。
・・・が、VBAからGmail送信したいときは、APIを使うよりもOutlookを使うなりCDOを使うなりした方が圧倒的に楽です。

というわけで、今回はCDOを使ってGmail送信を行うVBAマクロを紹介します。

※ 下記情報は 2014/08/11 時点の情報です。今後の仕様変更に伴って、下記マクロではメール送信できなくなる可能性があります。

■ Gmailのセキュリティ設定

CDOを使ってGmailを送信する前に、まずはGmail側でセキュリティ設定を変更する必要があります。

Google アカウントでログインした状態で「安全性の低いアプリを許可」ページを開き、「有効にする」にチェックを入れます。

SendGmailCDO_01

この設定を行わないと、マクロからメール送信しようとした時にアクセスがブロックされます。

■ CDOを使ってGmail送信を行うVBAマクロ

いよいよコードです。
SendGmailがメインとなるプロシージャーで、引数としてGoogle アカウントのメールアドレスやパスワード、宛先といった項目を指定します。

Option Explicit

Public Sub Sample()
  SendGmail "(Google アカウント)@gmail.com", _
            "(Google アカウント パスワード)", _
            "(Toアドレス)", _
            "(Ccアドレス)", _
            "(Bccアドレス)", _
            "件名:メールテスト", _
            "本文です。" & vbCrLf & "あいうえお" & vbCrLf & "かきくけこ", _
            "C:\Test\Sample.pdf"
End Sub

Private Sub SendGmail(ByVal AccountAddress As String, _
                      ByVal AccountPassword As String, _
                      ByVal MailTo As String, _
                      ByVal MailCc As String, _
                      ByVal MailBcc As String, _
                      ByVal MailSubject As String, _
                      ByVal MailBody As String, _
                      Optional ByVal AttachmentFilePath As String = "")
'CDOを使ってGmail送信を行う
  Const cdoBasic = 1
  Const cdoSendUsingPort = 2
  Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
  Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
  Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
  Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
  Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
  Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
  Const cdoSMTPUseSSL = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
  Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
 
  With CreateObject("CDO.Message")
    .From = AccountAddress
    .To = MailTo
    If Len(Trim(MailCc)) > 0 Then .CC = MailCc
    If Len(Trim(MailBcc)) > 0 Then .BCC = MailBcc
    .Subject = MailSubject
    .TextBody = MailBody
    If Len(Trim(AttachmentFilePath)) > 0 Then .Addattachment AttachmentFilePath
    With .Configuration.Fields
      .Item(cdoSendPassword).Value = AccountPassword
      .Item(cdoSendUserName).Value = AccountAddress
      .Item(cdoSendUsingMethod).Value = cdoSendUsingPort
      .Item(cdoSMTPConnectionTimeout).Value = 100
      .Item(cdoSMTPAuthenticate).Value = cdoBasic
      .Item(cdoSMTPServer).Value = "smtp.gmail.com"
      .Item(cdoSMTPServerPort).Value = 465
      .Item(cdoSMTPUseSSL).Value = True
      .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
End Sub

Gmail APIを使ってメール送信するVBAマクロ(3)」のコードに比べると、圧倒的に短くて簡潔ですね。

ただし、環境によっては上記コードではエラーになる場合があるので、その際はポート番号やSSLの設定を変更してみてください。

そして、どうしてもCDOでGmail送信できないときは、CDOに拘らず、BASP21といった外部コンポーネントや、Outlook経由での送信に切り替えることをお薦めします。

2016/10/12 追記:
メール本文の文字コードも指定できるようにしました。

関連記事

  1. Office アドイン

    [Officeアドイン]Excel Custom functionsのデバッグ方法

    前回の記事でExcelの新たな機能「Custom functions」…

  2. Office関連

    Excel 2016でUTF-8のCSVファイルがサポートされるようになりました。

    Office 2016の10月の機能更新によって、ExcelでUTF-…

  3. Office関連

    VALUE DOMAINで管理しているドメインをOffice 365で使用する。

    Office 365をセットアップすると設定される初期ドメイン「onm…

コメント

    • Taro
    • 2017年 4月 11日

    ありがとう 助かりました
    ポート21ブロックで 困っていました

    最後の添付ファイルにきずくのに 少し時間がかかりました
    ポート21ブロックで オロおろして 見過ごしました

    助かりました

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP