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

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


2020/5/17 追記:
安全性の低いアプリ」によるGmail送信ができなくなる予定であるため、Outlookを使うマクロについて記事を書きました。

Ignite 2016で発表されたOffice アドイン関連の情報前のページ

【感想】僕と君の大切な話1巻次のページ

関連記事

  1. Office関連

    「クラシックスタイルメニュー for Office 2010」のOffice 2013対応状況

    私が下記ページで公開しているフリーソフト「クラシックスタイルメニュー …

  2. Office関連

    「カレンダーから日付入力」をUserFormに移植してみました。

    前回の記事では、Office 用アプリ「カレンダーから日付入力」と同様…

  3. アイコン一覧

    Office 2013 アイコン一覧(I)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    選択中の図形の書式設定を一括変更するPowerPointマクロ

    PowerPointで複数の図形の書式を一つずつ変更するのが面倒だった…

  5. アイコン一覧

    Office 365アイコン(imageMso)一覧(O)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  6. Office関連

    Presentation Translatorが公開されました。

    下記記事で紹介している「Microsoft Translator アド…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP