[Excel VBA]ExcelのメールのテンプレートからGmailを送信する方法(マクロ)

VBA(Excel)

2016.12.292025.01.22

この記事は約2分で読めます。

記事内に広告が含まれていることがあります。

こんにちは。

メールを送信する際にGmailを使用している会社が多いようなので、

今回は、Excelで作成したメールのテンプレートからGmailを送信する方法を紹介します。

通常、Excelからメールを送信する場合、Outlookであれば、Outlook.Applicationオブジェクト、Thunderbirdであれば、Shellを使用することで簡単にメールが作成できますが、Gmailの場合は、すべての情報(To,Cc,Bcc,Subject(件名),Body(本文))をURLに変換し、規定ブラウザにて起動してあげる必要があります。

■事前設定

・VBE(Excelにてマクロ(コード)を書く画面)にて、参照設定に「Microsoft Active Data Object 2.x Library」を追加する。(To,Cc,Bcc,Subject(件名),Body(本文)をUTF-8に変換(URL)するために必要)

■コード

事前にセルに名前(To,Cc,Bcc,Subject,Body)が設定されている仮定で以下のコードを作成しました。

Private Constには、Gmailの基本的なURLが入っています。

URLとして使用できるように２バイト文字(ひらがな、カタカナ、漢字など)をUTF-8に変換します。(encodeUTF8)

Excel内セル改行コードはvbLfとなっていますが、URLとして使用するにはvbCrLf(URL標準改行コード)に変換してあげる必要があります。

Option Explicit

Private Const GmailURL   As String = "https://mail.google.com/mail/u/0/?view=cm&fs=1&tf=1&source=mailto"
Private Const SubURL     As String = "&su="
Private Const ToURL      As String = "&to="
Private Const CcURL      As String = "&cc="
Private Const BccURL     As String = "&bcc="
Private Const BodyURL    As String = "&body="

Sub メール送信()

    Dim URL As String
    Dim Body As String
    
    'メールアドレスが3種とも設定されていない場合のみエラー出力し処理終了
    If Range("To") & Range("Cc") & Range("Bcc") = Empty Then
        MsgBox "メールアドレスが設定されていません", vbCritical, "メール送信"
        Exit Sub
    End If

    'メッセージ
    If MsgBox("Gmailを開きます。" & vbCrLf & vbCrLf & _
            "To : " & Range("To") & vbCrLf & _
            "CC : " & Range("Cc") & vbCrLf & _
            "BCC : " & Range("Bcc") & vbCrLf & vbCrLf & _
            "Subject : " & Range("Subject") & vbCrLf & vbCrLf & _
            "本文 : " & Range("Body"), vbInformation + vbYesNo, "メール送信") = vbNo Then Exit Sub
    
    '本文以外のURL設定
    URL = GmailURL & SubURL & Range("subject") & ToURL & Range("To") & CcURL & Range("Cc") & BccURL & Range("Bcc") & BodyURL
    
    '本文のUTF-8エンコード　 & vblf(Excelセル内改行)⇒ vbCrLf(URL標準改行)
    Body = encodeUTF8(Replace(Range("Body"), vbLf, vbCrLf))

    '最終URL設定
    URL = URL & Body
    
    '既定ブラウザにてURLを開く
    CreateObject("Wscript.Shell").Run URL, 3

End Sub

Option Explicit

Private Const GmailURL As String = "https://mail.google.com/mail/u/0/?view=cm&fs=1&tf=1&source=mailto"

Private Const SubURL As String = "&su="

Private Const ToURL As String = "&to="

Private Const CcURL As String = "&cc="

Private Const BccURL As String = "&bcc="

Private Const BodyURL As String = "&body="

Sub メール送信()

Dim URL As String

Dim Body As String

'メールアドレスが3種とも設定されていない場合のみエラー出力し処理終了

If Range("To") & Range("Cc") & Range("Bcc") = Empty Then

MsgBox "メールアドレスが設定されていません", vbCritical, "メール送信"

Exit Sub

End If

'メッセージ

If MsgBox("Gmailを開きます。" & vbCrLf & vbCrLf & _

"To : " & Range("To") & vbCrLf & _

"CC : " & Range("Cc") & vbCrLf & _

"BCC : " & Range("Bcc") & vbCrLf & vbCrLf & _

"Subject : " & Range("Subject") & vbCrLf & vbCrLf & _

"本文 : " & Range("Body"), vbInformation + vbYesNo, "メール送信") = vbNo Then Exit Sub

'本文以外のURL設定

URL = GmailURL & SubURL & Range("subject") & ToURL & Range("To") & CcURL & Range("Cc") & BccURL & Range("Bcc") & BodyURL

'本文のUTF-8エンコード　 & vblf(Excelセル内改行)⇒ vbCrLf(URL標準改行)

Body = encodeUTF8(Replace(Range("Body"), vbLf, vbCrLf))

'最終URL設定

URL = URL & Body

'既定ブラウザにてURLを開く

CreateObject("Wscript.Shell").Run URL, 3

End Sub

Option Explicit

Function encodeUTF8(mytext As String) As String

    Dim mystream As New ADODB.Stream
    Dim mybinary, mynumber
    
    With mystream
    
        .Open
        .Type = adTypeText
        .Charset = "UTF-8"
        .WriteText mytext
        .Position = 0
        .Type = adTypeBinary
        .Position = 3
        mybinary = .Read
        .Close
        
    End With
    
    For Each mynumber In mybinary
    
        encodeUTF8 = encodeUTF8 & "%" & Hex(mynumber)
        
    Next
    
End Function

Option Explicit

Function encodeUTF8(mytext As String) As String

Dim mystream As New ADODB.Stream

Dim mybinary, mynumber

With mystream

.Open

.Type = adTypeText

.Charset = "UTF-8"

.WriteText mytext

.Position = 0

.Type = adTypeBinary

.Position = 3

mybinary = .Read

.Close

End With

For Each mynumber In mybinary

encodeUTF8 = encodeUTF8 & "%" & Hex(mynumber)

End Function

---コメント---

男より:

2019-08-14 16:45

大変勉強になっております

Function encodeUTF8(mytext As String) As String 以降でエラーが生じてしまうのですが、
Dim mystream As New ADODB.Streamdeでユーザー定義のエラーが生じた場合はどうしたらよいか教えていただいてもよろしいでしょうか。

返信
- あおいうえ＠仮想通貨小額分散＆備忘録より:
  
  2019-09-10 22:58
  
  ご拝読ありがとうございます。
  ユーザー定義のエラーということで、
  参照設定で、下記のライブラリにチェックは入っていますでしょうか？
  Microsoft Active Data Object x.x Library
  (x.xはバージョン 2.8 or 6.1 等)
  
  ご確認ください。
  
  返信
YAMADA より:

2020-07-05 11:49

大変、参考にさせて頂いております。

Gmailが会社の独自ドメインでログインして使用している場合（Gsuite)、URL：”https://mail.google.com/mail/u/0/?view=cm&fs=1&tf=1&source=mailto”はどう変更すればよいでしょうか？また、変更の必要はないのでしょうか？

【補足】会社で使用しているGmailが、会社のドメインでログインされたメール作成フォームでないと「送信ができない」仕様になっています。

返信
- あおいうえ＠仮想通貨小額分散＆備忘録より:
  
  2020-09-23 09:17
  
  URLの変更は不要です。
  ChromeとGsuiteの両方でログインをしてから使ってください。
  
  返信
太郎より:

2020-07-09 21:24

こんばんわ

Gsuiteで管理されているgmailだと、「400 Bad Request」が出てしまいます（自宅（通常）のgmailは問題ありません）。

何かいい方法はありますでしょうか？
ちなみにGsuiteの管理者PWなどは教えてもらえない状況です。
毎日、会社で同じメールを作っているので、上記のVBAを喉から手が出るほど使いたいです。

返信
- あおいうえ＠仮想通貨小額分散＆備忘録より:
  
  2020-09-23 09:14
  
  エラーの内容がわからないので回答しづらいのですが、こちらでもGsuiteを使っていたので動作させることは可能だと思います。
  また、Gsuiteを使っているのであれば、ExcelよりもGoogleスプレッドシートを使うのも手です。
  Googleスプレッドシートで使えるマクロ(Google Apps Script/通称GAS)でGmailApp.sendEmailまたはMailApp.sendEmailを使うと良いと思われます。
  
  返信