Office関連

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

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

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

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

ただ、上記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

メール送信時に文字コードを指定する必要がある場合は、上記コードをお試しください。

関連記事

  1. Office関連

    Wikipediaの検索予測キーワードの一覧を取得するVBAマクロ

    Wikipediaのサーチボックスにキーワードを入力すると、入力したキ…

  2. Office関連

    Excel 2013で追加された「UNICHAR」関数を使って特殊文字を表示する。

    「Excel 2013で追加された「WEBSERVICE」関数を使って…

  3. Office アドイン

    [Office用アプリ]法人登録する際の参考資料

    法人としてMicrosoft Seller DashboardでOff…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP