メール自動作成用のクラスを作る～(3) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

Thunderbirdでメールを自動作成するメソッドを作成。

まずはコードをご覧に入れよう。

あ、その前に、標準モジュールの宣言セクションに、

Public Const THUNDERBIRD_PATH As String = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"

こいつを追加。Thunderbirdでメールを作成するときには、Shell関数というものを用いるんですが、その引数に実行ファイルのフルパスがいるので、定数に放り込んであるわけです。もちろん、お使いの環境に合わせて変更が必要。

それじゃ、気を取り直してコードのご紹介。

Thunderbirdのメール自動作成メソッド

コード

Public Sub createThunderbirdMail()
  'Shell関数の引数を作る
  Dim thunderbirdPath As String
  thunderbirdPath = THUNDERBIRD_PATH & "-compose "  '……(1)
  '件名をセット                                                         '……(2)
  If mailSubject_ = "" Then
    mailSubject_ = "無題"                                               '……(3)
  End If
  '左肩部分をセット
  Dim strBody As String                                                 '……(4)
  strBody = belongsTo_ & "%0A" & "　" & _
            jobTitle_ & "　" & _
            personName_ & "　様"
  '左肩部分の下に２行文空行をセット
  strBody = strBody & "%0A" & "%0A" & "%0A"
  '本文をstrBodyに連結していく
  Dim i As Integer
  For i = 1 To numOfBody_
    strBody = strBody & mailBody_(i) & "%0A" & "%0A"
  Next
  strBody = Replace(strBody, ",", "，")                                 '……(5)
  strBody = Replace(strBody, vblf, "%0A"                                '……(5')
  '添付ファイルフルパスをつなぐ
  Dim strAttFile As String                                              '……(6)
  For i = 1 To numOfAttFiles
    strAttFile = strAttFile & attFiles_(i) & ","
  Next
  '右端の「,」を除去する                                                '……(7)
  If Right(strAttFile, 1) = "," Then
    strAttFile = Left(strAttFile, Len(strAttFile) - 1)
  End If
  '両端を「'」で囲む。
  strAttFile = "'" & strAttFile & "'"                           '……(8)
  'メールを作成する                                                     '……(9)
  Shell thunderbirdPath & _
    "to=" & mailTo_ & "," & _
    "cc=" & CC_ & "," & _
    "bcc=" & BCC_ & "," & _
    "subject=""" & mailSubject_ & """," & _
    "body=""" & strBody & """," & _
    "attachment=""" & strAttFile & """"
End Sub

解説の前に基本方針をば。Shell関数でThunderbirdメールを作るときの基本構文は、

Shell "Thunderbird実行ファイルのフルパス -compose _
to=送信先メールアドレス, _
cc=CCアドレス, _
subject=メール件名, _
body=本文文字列, _
attachment='添付ファイルフルパス'"

というものらしい。だから、それぞれのパーツ（実行ファイルのフルパスとか、「-compose」というスイッチとか、メールアドレスなんかの必要な文字列）は、全て一旦変数に入れてから使用することにする（コード中の(9)のところ）。

添付ファイルが複数あるときは、フルパスを「,」（カンマ）で区切って、全体を「'」（シングルクォート）で括る、ということなんだけれども、別に一つだけを「'」で括ろうが、添付ファイルなしで「attachment=」の右辺が「''」になっていようが問題ないっぽい。

コードの解説

(1)では、Shell関数に与える引数と、メール作成用のスイッチ（なのかな？）をセットにした文字列を一旦変数「thunderbirdPath」に格納している。「"」のエスケープの関係で、「"」の対応関係がめちゃくちゃややこしくなっています。誰か上手に説明できる人がいたら説明お願いします。
【20190428追記】
どうも、アホみたいに「"」を入れる必要がないようだったので、シンプルに修正しました。
(2)は、件名（MailDataオブジェクトのmailSubjectプロパティ）が空白の場合の対応。これが結構重要で、件名に空の文字列が渡されてしまうと、なぜかひどいことになるので注意。
だから、空白の時は(3)で「無題」という文字列を与えて空白にならないようにする。
(4)では、メールの本文の部分を作っている。基本、すでにMailBodyクラスのインスタンスが保持している文字列データを連結しているだけなので何も難しいことはないと思う。改行が「%0A」だということぐらいがポイントかな。
(5)では、本文文字列中の「,」（半角カンマ）を全角に置換している。本文文字列中に半角カンマがあるとひどいことになるらしいので。
(5')は、セル内の改行を、Thunderbirdの改行コード（って言うの？）「%0A」に置換。[Alt]+[Enter]によるセル内改行は「vblf」みたいですね。
※追記
(6)で、添付ファイルのフルパスを連結している。連結時に「,」を加えているところがポイント。
そうすると、連結文字列の最後が「,」になってしまうので、(7)で右端の「,」を除去。
ただし、この過程が必要なのかどうかは試していない。
(8)では、添付ファイルフルパスを連結した文字列を「'」で括っている。こうすることで複数の添付ファイルを渡すことができるということなんだってさ。
ここまでで下ごしらえは完了したので、後は基本構文の通りにデータを与えるだけ。(9)以下の８行がそうなんですけど、行継続文字でつないでいるので、実際は１行です。

実行準備

後々LotusNotesと使い分ける時のことも考えて、

f:id:akashi_keirin:20170312095059j:plain

こんなふうにしてみた。

それに伴って、標準モジュールのコードも少し書き換えた。

実行用のコード

まずは、宣言セクションで、

Public Const APP_LOTUSNOTES As Integer = 1
Public Const APP_THUNDERBIRD As Integer = 2

二つの定数を宣言。

前回作成したメインのコードを少し書き換える。

Sub voidMain(ByVal appNum As Integer)                      '……(1)
  Dim baseCell As Range
  Set baseCell = ActiveCell
  If booleanCheckActiveCell(baseCell) = False Then
    Call makeUserSick
    Set baseCell = Nothing
    Exit Sub
  End If
  Dim objSh As Worksheet
  Set objSh = baseCell.Parent
  Dim n As Integer  'カウント用変数
  Dim baseRow As Long
  baseRow = baseCell.Row
  '構造体変数mldtに、メールの基本情報をセットする
  Call setMailBasicData(baseCell)
  Set md = New MailData
  'MailBodyクラスのインスタンスにメールの基礎データをセット
  md.getMailBasicData mldt                '……(1)
  '本文文字列の入っているセルを数えて変数「n」にセット
  Dim i As Integer
  n = 0
  For i = colNum.p01 To colNum.p10
    If objSh.Cells(baseRow, i).Value = "" Then
      Exit For
    Else
      n = n + 1
    End If
  Next
  '本文を配列に格納する。
  Call setMailBody(baseCell, n)
  'MailDataクラスのインスタンスにメール本文の配列をセット
  md.getMailBodyArray mlBody()
  '添付ファイルのフルパスが入っているセルを数えて変数「n」にセット
  n = 0
  For i = colNum.att01 To colNum.att10
    If objSh.Cells(baseRow, i).Value = "" Then
      Exit For
    Else
      n = n + 1
    End If
  Next
  '添付ファイルのフルパスを配列に格納する。
  Call setAttachmentFiles(baseCell, n)
  '添付ファイルフルパスの取得に失敗していたら処理を終了
  If isFailed = True Then
    Set md = Nothing
    Exit Sub
  End If
  'MailDataクラスのインスタンスに添付ファイルフルパスの配列をセット
  md.getMailAttFilesArray mlAttFiles()
  '送信者データを配列に格納する
  Call setSenderData(Range("UserInformationTable").Rows.Count)
  'MailDataクラスのインスタンスにユーザー情報の配列をセット
  md.getSenderDataArray mlSenderData()
  If appNum = APP_LOTUSNOTES Then                                     '……(2)
    'LotusNotesでメールを作成する
    md.createLotusNotesMail
  End If
  If appNum = APP_THUNDERBIRD Then
    'Thunderbirdでメールを作成する
    md.createThunderbirdMail
  End If
  objSh.Cells(baseRow, colNum.isSent).Value = "済"
  Set flp = Nothing
  Set md = Nothing
End Sub

余計なDebug.Printを消したのでちょっと短くなった。

んで、標準モジュールに次の二つのメソッドを追加。

Sub callLotusNotes()
  Set nsc = New NotesStartedChecker
  With nsc
    .checkNotesIsStarted _
      "ちょｗｗｗ　おまｗｗｗ" & vbCrLf & _
      "LotusNotesが起動してないしｗｗｗ" & vbCrLf & _
      "LotusNotesを起動・ログインして出直してこいやｗｗｗ" & vbCrLf & _
      "    　＿＿＿＿＿＿＿＿_" & vbCrLf & _
      "　／　　　　　　　　  ＼ " & vbCrLf & _
      "／　／・＼　　／・＼　  　＼" & vbCrLf & _
      "|　　￣￣　　　￣　　 　　|　ち～んｗ" & vbCrLf & _
      "|　　　　（＿人＿）　　 　|" & vbCrLf & _
      "|　　　　　＼ 　   |   　    　 |" & vbCrLf & _
      "＼　　　　 　＼＿|　　   ／"
    If .isStarted = False Then
      Set nsc = Nothing
    Else
      Set nsc = Nothing
      Call voidMain(APP_LOTUSNOTES)                                   '……(3)
    End If
  End With
End Sub

Sub callThunderbird()
  Call voidMain(APP_THUNDERBIRD)                                      '……(4)
End Sub