Thunderbirdのメールを作成するクラスを作った - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

Thunderbirdメール作成用のクラスを作成した

前回

akashi-keirin.hatenablog.com

のRecipientクラス、Senderクラスは、今回も使用する。

ソースコード

クラスモジュール　ThunderbirdApp

Option Explicit

Implements IMailCreatable

Private exePath As String
Private isAvailable As Boolean

Public Sub init(ByVal thunderbirdExePath As String)
  isAvailable = False
  exePath = thunderbirdExePath
  Dim fsObj As New FileSystemObject
  If fsObj.FileExists(exePath) Then isAvailable = True
End Sub

Public Sub IMailCreatable_createMail( _
             ByVal targetRecipient As Recipient, _
             ByVal currentSender As Sender, _
             ByVal mailSubject As String, _
             ByRef mailBody() As String, _
             ByRef attFilePath() As String, _
    Optional ByVal allowReturnReceipt As Boolean = False)
  If Not isAvailable Then Exit Sub
  'Shell関数の引数を作る'
  Dim thunderbirdPath As String
  thunderbirdPath = exePath & " -compose "
  '件名をセット'
  If mailSubject = "" Then mailSubject = "無題"
  '左肩部分をセット'
  Dim bodyString As String
  With targetRecipient
    bodyString = .CompanyName & "%0A" & "　" & _
                 .JobTitle & "　" & _
                 .Name & "　様"
  End With
  '左肩部分の下に２行文空行をセット'
  bodyString = bodyString & "%0A" & "%0A" & "%0A"
  '本文をbodyStringに連結していく'
  Dim i As Long
  For i = LBound(mailBody) To UBound(mailBody)
    If mailBody(i) <> "" Then _
      bodyString = bodyString & mailBody(i) & "%0A" & "%0A"
  Next
  bodyString = Replace(bodyString, ",", "，")
  bodyString = Replace(bodyString, "vblf", "%0A")
  '添付ファイルフルパスをつなぐ'
  Dim attFilesString As String
  For i = LBound(attFilePath) To UBound(attFilePath)
    If attFilePath(i) <> "" Then _
      attFilesString = attFilesString & attFilePath(i) & ","
  Next
  '右端の「,」を除去する'
  If Right(attFilesString, 1) = "," Then
    attFilesString = Left(attFilesString, Len(attFilesString) - 1)
  End If
  '両端をシングルクオートで囲む'
  attFilesString = "'" & attFilesString & "'"
  'メールを作成する'
  With targetRecipient
    Call Shell(thunderbirdPath & _
               "to=" & Replace(.MailAddress, ",", ";") & "," & _
               "cc=" & Replace(.CC, ",", ";") & "," & _
               "bcc=" & Replace(.BCC, ",", ";") & "," & _
               "subject=""" & mailSubject & """," & _
               "body=""" & bodyString & """," & _
               "attachment=""" & attFilesString & """")
  End With
End Sub

エラー対応なんかはまだ。

あと、受信確認を設定する方法がわからないので、IMailCreatable_createMailメソッドの引数allowReturnReceiptが何の意味もなく設定されている。

IMailCreatableインターフェースで引数も含めて定義したために、削ることができなかった。

IMailCreatableインターフェース内で、