Office関連

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

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

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

今回は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アカウントを設定しておく必要があります。
設定方法は下記サイトで詳しく説明されているので、こちらをご参照ください。

CDOが使えなくなる以上、Outlookを使うのが簡単だと思うのですが、想像以上に送信に時間が掛かりました。
下記記事のように、直接APIを叩いた方が使い勝手が良いかもしれません。
(VBAで実装するのは面倒ですが・・・)

[Office Scripts]ワークシート関数を実行しようとして失敗した話前のページ

[Google Apps Script]スプレッドシートで選択範囲を変更したときに実行されるonSelectionChangeトリガー次のページ

関連記事

  1. Office関連

    [Excel Services ECMAScript]選択範囲が変更されたときのイベントを利用する。…

    埋め込んだExcelワークブックの、選択範囲が変更されたときのイベント…

  2. Office関連

    「印刷の向き」の変更を検知するExcelマクロ

    MSDNフォーラムに「「印刷の向き」の「縦」「横」ボタンがクリックされ…

  3. Office関連

    [Excel Services ECMAScript]jPrintAreaで埋め込んだブック部分のみ…

    jQuery + jPrintAreaを利用して、埋め込んだExcel…

  4. Office関連

    Wordマクロで文字数を取得する方法をまとめてみました。

    「蛍光ペンでマークした部分の文字数をカウントするWordマクロ」で蛍光…

  5. Office関連

    Word 2013とWord 2010のダミー文章の比較

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP