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

ホーム
Office関連, Excel, Word, PowerPoint, Google関連
CDOを使ってGmail送信を行うVBAマクロ(UTF-8対応版)

Office関連

2016.10.12

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

2年ほど前にCDOを使ってGmail送信を行うVBAマクロについて記事を書きました。

2014.08.11

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

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

そして先日、このマクロに対して「UTF-8でメール送信できないか？」という質問があることに気が付きました。

エクセルからgmailでの送信
http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=178509&rev=0

なるほど。
たしかに先の記事ではメールの文字コードについて意識していませんでした。

ただ、上記Q&Aページの回答にもあるように、BodyPartオブジェクトのCharsetプロパティを設定することで、送信するメールの文字コードを指定することが出来ます。

下記コードは、以前書いた記事のコードに、文字コードを指定するための「MailCharset」パラメータを追加したもので、特に指定が無い場合は「iso-2022-jp」でメール送信を行います。

Option Explicit
 
Public Sub Sample()
  SendGmail "(Google アカウント)@gmail.com", _
            "(Google アカウント パスワード)", _
            "(Toアドレス)", _
            "(Ccアドレス)", _
            "(Bccアドレス)", _
            "件名：メールテスト", _
            ChrW(&H4F60) & ChrW(&H597D) & vbCrLf & "あいうえお" & vbCrLf & "かきくけこ", _
            "utf-8"
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 MailCharset As String = "iso-2022-jp", _
                      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"
  
  'Charset設定
  MailCharset = LCase(StrConv(MailCharset, vbNarrow))
  Select Case MailCharset
    Case "big5", "euc-jp", "euc-kr", "gb2312", "iso-2022-jp", _
         "iso-2022-kr", "iso-8859-1", "iso-8859-2", "iso-8859-3", "iso-8859-4", _
         "iso-8859-5", "iso-8859-6", "iso-8859-7", "iso-8859-8", "iso-8859-9", _
         "koi8-r", "shift-jis", "us-ascii", "utf-7", "utf-8"
    Case Else: MailCharset = "shift-jis"
  End Select
  
  With CreateObject("CDO.Message")
    .From = AccountAddress
    .To = MailTo
    .BodyPart.Charset = MailCharset
    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

上記Sampleマクロを実行すると、下図の通りメールの文字コードがUTF-8になり、中国語も問題無く表示されます。

sendgmailcdo_02