メールの本文に各ユーザーの書式設定を保持したまま文字列を追加する方法がわからなくてかなり悩んだけど、なんとか解決できたのでメモ。
メール作成
- メールはHTML形式で作成
- フォント、およびフォントサイズは固定でなく、各ユーザーの書式設定を使用
答えはMailItem.GetInspector プロパティ (Outlook)にありました。
メールの本文欄(MailItem).GetInspector.WordEditorをWordオブジェクトとして扱い、wdDoc.Range(0)で本文欄の先頭を取得→wdRange.InsertBefore "本文"で先頭に本文を挿入、という処理。
「HTMLタグでフォント指定して(MailItem).HTMLBodyと繋げる」という処理をしているメール作成VBSを流用したのもあり、ずっと「フォント設定はどこから取得するんだ？」という発想でやっていましたが、そもそも「本文の先頭に文字列を追加」でよかったという。
Private Sub メール作成ボタン_Click()
Rem 参照設定：Microsoft Outlook 16.0 Object Library
Dim olApp As New Outlook.Application
Dim olMail As Outlook.MailItem
Rem 参照設定：Microsoft Word 16.0 Object Library
Dim wdDoc As Word.Document
Dim wdRange As Word.Range
Rem HTML形式でメールを作成
Set olMail = olApp.CreateItem(0)
olMail.BodyFormat = 2
Rem 送付先
olMail.To = "to@test"
olMail.Cc = "cc@test"
olMail.Bcc = "bcc@test"
Rem 件名
olMail.Subject = "件名"
Rem 本文
olMail.Display
Set wdDoc = olMail.GetInspector.WordEditor
If Not wdDoc Is Nothing Then
Set wdRange = wdDoc.Range(0) '本文欄の先頭を取得
wdRange.InsertBefore "本文" '先頭に挿入
End If
Set wdRange = Nothing: Set wdDoc = Nothing
Set olMail = Nothing
Set olApp = Nothing
End Sub
※実際は送付先／件名／本文に固定の文字列ではなくテーブルに記録したデータを使用していますが、単にrs.OpenしてMailItemに突っ込むだけなので省略。
olMail.GetInspector.WordEditor.Content.Font.Sizeでフォントサイズが取得できるけど、何故かものすごく大きな数字になるとか。
テーマのフォントを使っているとolMail.GetInspector.WordEditor.Content.Font.Nameではフォント名を取得できないとか。
上の方法でサイズとフォントを取得してHTMLタグに入れて.HTMLBodyと繋げても、署名のフォント設定に引っ張られるとか。
結構色々考えたんですけど、これらは全部使いませんでした。
おまけ
メールテンプレートを作成するフォームを作成し、「可変の内容に対応できるように置換される文字列」を挿入する『符号追加ボタン』を設置した。
「メールの作成日」を件名・本文に挿入できるボタンも作成し、7パターンの符号を追加できるようにした。
- [日付:m.d]
- [日付:m/d]
- [日付:mm.dd]
- [日付:mm/dd]
- [日付:yyyy.mm.dd]
- [日付:yyyy/mm/dd]
- [日付:yyyy年m月d日]
メール作成処理に組み込むことで、符号内で指定されたフォーマットで日付を挿入できる。
ボタンで挿入できるのは7パターンだが、書式のアレンジにも対応できる処理にしている。
Dim strBody As String
Dim fugou As String, fugDate As String
strBody = rs!ml_Body
Rem 日付符号が含まれている間処理する
Rem 複数の符号が入っている可能性を考慮してループ処理
Do While InStr(1, strBody, "[日付:") > 0
fugou = GetF1toF2(strBody, "[", "]") '日付符号を抽出
fugDate = Format(Date, Mid(fugou, 5, Len(fugou) - 5)) '日付符号のフォーマットで今日の日付を変換
strBody = Replace(strBody, fugou, fugDate) '日付符号を日付に置換
Loop
上記の処理には文字列を抽出するユーザー定義関数を使用している。
Function GetF1toF2(strTgt, strFind1, strFind2) As String
Rem Get Find1 To Find2
Rem 検索対象文字列(strTgt)内を先頭から検索し，検索文字列1(strFind1)から検索文字列2(strFind2)までを返す。
On Error Resume Next
GetF1toF2 = Left(Mid(strTgt, InStr(1, strTgt, strFind1)), InStr(1, Mid(strTgt, InStr(1, strTgt, strFind1)), strFind2))
End Function
