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

ホーム
Office関連, Excel, Word, PowerPoint, Outlook, Google関連
Outlookを使ってGmail送信を行うVBAマクロ

2020.05.17

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

下記G Suite アップデートブログにある通り、今年の6月には“安全性の低いアプリ”によるGmailやカレンダーといったGoogleのサービスに新規接続ができなくなり、2021年2月には、安全性の低いアプリへの接続はすべて無効になります。

G Suite アップデートブログ

安全性の低いアプリによる G Suite アカウントへの接続が無効に

https://gsuiteupdates-ja.googleblog.com/2019/12/g-suite_24.html

この記事は 12 月 16 日に英語版ブログに掲載された記事を翻訳したものです。変更点について安全性の低いアプリによる G Suite アカウントデータへのアクセスを制限することになりました。この変更は 2020 年 6 月から適用されます。安全性の低いアプリ...

当ブログで以前書いた下記記事、「CDOを使ってGmail送信するVBAマクロ」も使えなくなるわけですね。

2014.08.11

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

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

2016.10.12

CDOを使ってGmail送信を行うVBAマクロ(UTF-8対応版)

2年ほど前にCDOを使ってGmail送信を行うVBAマクロについて記事を書きました。そして先日、このマクロに対して「UTF-8でメール送信できないか？」という質問があることに気が付きました。エクセルからgmailでの送信 http...

今回はCDOの代わりにOutlookを使ってGmail送信を行うVBAマクロをご紹介します。

Option Explicit

Public Sub Sample()
  Dim olApp As Object
  Dim v As Variant
  Const olFormatPlain = 1 'Outlook.OlBodyFormat
  
  'Outlookが起動していないと送信できない場合があるので事前に起動
  On Error Resume Next
  Set olApp = GetObject(, "Outlook.Application")
  If olApp Is Nothing Then
    Shell "OUTLOOK.EXE", vbNormalFocus
    Do
      Set olApp = GetObject(, "Outlook.Application")
      DoEvents
    Loop While olApp Is Nothing
  End If
  On Error GoTo 0
  
  '添付ファイル
  v = Array("C:\temp\job_barista_man.png", _
            "C:\temp\job_barista_woman.png", _
            "C:\temp\job_cafe_tenin_woman.png")
  
  SendGmailUsingOutlook _
    MailApp:=olApp, _
    AccountAddress:="*****@gmail.com", _
    MailTo:="*****@hogehoge.org", _
    MailCc:="", _
    MailBcc:="", _
    MailSubject:="【テストメール】", _
    MailBody:=ChrW(&H4E3A) & ChrW(&H4E86) & ChrW(&H68C0) & ChrW(&H67E5) & ChrW(&H6D4B) & _
              ChrW(&H8BD5) & ChrW(&H73AF) & ChrW(&H5883) & vbNewLine & ChrW(&H8BF7) & ChrW(&H628A) & _
              ChrW(&H6570) & ChrW(&H636E) & ChrW(&H53D1) & ChrW(&H7ED9) & ChrW(&H6211), _
    MailBodyFormat:=olFormatPlain, _
    AttachmentFilePath:=v, _
    FlgSend:=True
End Sub

Private Sub SendGmailUsingOutlook( _
  ByVal MailApp As Object, _
  ByVal AccountAddress As String, _
  ByVal MailTo As String, _
  ByVal MailCc As String, _
  ByVal MailBcc As String, _
  ByVal MailSubject As String, _
  ByVal MailBody As String, _
  Optional ByVal MailBodyFormat As Long = 1, _
  Optional ByVal AttachmentFilePath As Variant = Empty, _
  Optional ByVal FlgSend As Boolean = True)
'Outlookを使ってGmail送信を行うVBAマクロ
'※要Gmailアカウントの追加
'https://support.office.com/ja-jp/article/70191667-9c52-4581-990e-e30318c2c081 参照
  
  Dim accGmail As Object 'Outlook.Account
  Dim i As Long
  Const olMailItem = 0
  
  Set accGmail = MailApp.Session.Accounts.Item(AccountAddress)
  If accGmail Is Nothing Then Exit Sub
  With MailApp.CreateItem(olMailItem)
    .To = MailTo
    If Len(Trim(MailCc)) > 0 Then .CC = MailCc
    If Len(Trim(MailBcc)) > 0 Then .BCC = MailBcc
    .Subject = MailSubject
    .BodyFormat = MailBodyFormat
    If Not IsEmpty(AttachmentFilePath) Then
      For i = LBound(AttachmentFilePath) To UBound(AttachmentFilePath)
        .Attachments.Add AttachmentFilePath(i)
      Next
    End If
    .Body = MailBody
    Set .SendUsingAccount = accGmail
    If FlgSend Then
      .Send
    Else
      .Display
    End If
  End With
End Sub

MailItemオブジェクトを作って送るだけの、何のひねりも無いコードです。

ただ、テスト環境では、添付ファイルを指定した際にOutlookが起動していない状態だと上手く送信できなかったため、事前にOutlookを起動するようにしています。

仕様上、上記コードを実行する前に、OutlookにGmailアカウントを設定しておく必要があります。
設定方法は下記サイトで詳しく説明されているので、こちらをご参照ください。