OutLookメール自動作成メソッド - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

メール自動作成ツール～Outlookへの対応

このとき

akashi-keirin.hatenablog.com

作成したメール自動作成ツール、LotusNotes、Thunderbirdの両方に対応していて非常に便利なので、重宝している。

で、せっかくなのでOutlookにも対応させてみようと思い、ちょっとやってみた。

前に作成したクラスに、Outlookメール作成メソッドを追加する。

参考：今回使用する自作クラスのプロパティ一覧

プロパティ	型	説明
mailTo	String	宛先のメールアドレス
CC	String	CCアドレス
BCC	String	BCCアドレス
mailSubject	String	メールの件名
belongsTo	String	名宛て人の所属
jobTitle	String	名宛て人の肩書
personName	String	名宛て人の名前
returnReceipt	String	受信確認の有無
mailBody	String	メール本文
attFiles	String	添付ファイルフルパス
senderData	String	送信人のデータ
numOfBody	Integer	本文の段落数
numOfAttFiles	Integer	添付ファイル数
numOfSenderData	Integer	送信人データの行数

今にして思えば、最後の３つとか、クラスの外部に公開する意味ないなー。

Outlookに対応する

createOutlookMailというメソッド名にした。

メソッドのコードを載せる。

Public Sub createOutlookMail()
On Error Resume Next
  Err.Clear
  Dim objOutlook As Outlook.Application
  Set objOutlook = GetObject(, "Outlook.Application")    '……(1)'
  If objOutlook Is Nothing Then _
      makeUserSick "Outlookが起動してないしｗｗｗ": End    '……(2)'
  '本文文字列の作成'
  '左肩部分の作成'
  Dim strAddressee As String
  strAddressee = belongsTo_ & vbCrLf & "　" & _
                 jobTitle_ & "　" & _
                 personName_ & "　様" & _
                 vbCrLf & vbCrLf & vbCrLf    '……(3)'
  '本文をstrBodyに連結していく'
  Dim strBody As String
  Dim i As Integer
  For i = 1 To numOfBody    '……(4)'
    strBody = strBody & mailBody_(i) & vbCrLf & vbCrLf
  Next
  Dim objMailItem As MailItem
  Set objMailItem = objOutlook.CreateItem(olMailItem)    '……(5)'
  With objMailItem
    'デフォルトの署名文字列を取得するために一旦RichText形式にする    ……(6)'
    .BodyFormat = olFormatRichText
    .Display
    'この時点ではBodyプロパティには署名文字列しか入っていないので、'
    '署名文字列を変数に入れる。'
    Dim signatureString
    signatureString = .Body
    'ここでHTML形式に変える'
    .BodyFormat = olFormatHTML
    .To = mailTo    '……(7)'
    .CC = CC_
    .BCC = BCC_
    .Subject = mailSubject_
    '左肩、本文、署名の順にBodyプロパティに書き込む'
    .Body = strAddressee & _
            strBody & vbCrLf & vbCrLf & _
            signatureString
    '添付ファイルの設定'
    If numOfAttFiles_ <> 0 Then
      For i = 1 To numOfAttFiles_
        .Attachments.Add attFiles_(i)
      Next
    End If
  End With
  If Err.Number > 0 Then
    Call errorCatch("MailDataクラスのcreateOutlookMailメソッド", _
                    Err.Number, _
                    Err.Description)
    MsgBox "【Main】シートへの入力に不備がなかったか、確認してやり直してください。", _
           vbCritical
  End If
On Error GoTo 0
End Sub

ちょい長くなってしまったけれど、単にメールを作るだけならそんなに難しいとは感じなかった。

まず、(1)の

Set objOutlook = GetObject(, "Outlook.Application")

で現在起動中のOutlookアプリケーションオブジェクトを取得。

(2)の

If objOutlook Is Nothing Then _
    makeUserSick "Outlookが起動してないしｗｗｗ": End

では、Outlookが起動していなかったらobjOutlookがNothingになるはずなので、ユーザーを煽って処理自体を終了。

makeUserSickは、もちろんこのときのやつですｗ

いきなりEndで終わるなんて、何か投げやりな対応なので、今後詰めていく必要がありそう。

(3)の

strAddressee = belongsTo_ & vbCrLf & "　" & _
                 jobTitle_ & "　" & _
                 personName_ & "　様" & _
                 vbCrLf & vbCrLf & vbCrLf

では、本文の宛名の部分の文字列を作成。まあ、別に本文と分離する必要はないかなあとも思ったんだが、一応、別々にしといた。

(4)の

For i = 1 To numOfBody_    '……(4)'
  strBody = strBody & mailBody_(i) & vbCrLf & vbCrLf
Next

では、本文を段落ごとに格納した内部配列mailBody_()から要素を取り出してきて、改行コードとともに連結している。

ここまでで、本文の左肩部分と本文がそれぞれひとかたまりの文字列になっている。

ここからがOutlook側の処理。

まず、(5)の

Set objMailItem = objOutlook.CreateItem(olMailItem)

でMailItemオブジェクトをインスタンス化する。

まだイマイチMailItemオブジェクトって何者なのかよく分かっていない。

MailItems.Add とかだと理解しやすいんだけれど、どうもそういうオブジェクトモデルではないらしい。

んで、(6)からの５行（コメント除く）がちょっとめんどくさい。

'デフォルトの署名文字列を取得するために一旦RichText形式にする'
.BodyFormat = olFormatRichText
.Display
'この時点ではBodyプロパティには署名文字列しか入っていないので、'
'署名文字列を変数に入れる。'
Dim signatureString
signatureString = .Body
'ここでHTML形式に変える'
.BodyFormat = olFormatHTML

手順としては、

RichText形式を指定→新規メールを表示→署名文字列を変数に格納→HTML形式に変換

という形。

なんでこんなに面倒なことをしているのかというと、

はじめからHTML形式を指定するとデフォルトの署名が書き込まれない

から。このあたりの挙動は、そもそもOutlookの設定でなんとかなるかも知れない。Outlookは今まで使ったことがなかったのでよく分かっていないのです。

まあ、ここまででメール本体を作り上げる準備ができたことになるので、あとは(7)からの12行（実質10行。コメント除く）

.To = mailTo
.CC = CC_
.BCC = BCC_
.Subject = mailSubject_
'左肩、本文、署名の順にBodyプロパティに書き込む'
.Body = strAddressee & _
        strBody & vbCrLf & vbCrLf & _
        signatureString
'添付ファイルの設定'
If numOfAttFiles_ <> 0 Then
  For i = 1 To numOfAttFiles_
    .Attachments.Add attFiles_(i)
  Next
End If

で一気に必要事項を書き込んでおしまい。