excel vba でOutlook mailを新規作成し、本文にexcel シートのデータを貼り付けたい

2014-02-14

質問

_{2014年2月14日金曜日 3:20}

＜やりたいこと＞
Sheet1のボタンが押されたら、Sheet2のデータを２箇所範囲コピーし、OutLookの新規メールを開きSheet1の該当セルデータをBodyで出力し、Sheet2の範囲コピーしたデータをそのメール本文へ出力したい。

①Sheet2のデータを範囲指定（２箇所:A,B）、コピー
②Outlookの本文へAを貼付
③Outlookの本文へBodyに代入したテキストを書き込み（できればここのテキストのフォントを赤色にしたい）
④Outlookの本文へBを貼付

現在、以下の構文で①②は出来ています。
③の書き込みは出来ますが、フォント変更の仕方がわかりません。（全体フォントは設定どおり、全てリッチテキストにしたいです）
④については、以下の構文では②のAを貼付と同時にBも貼付てしまう為、②③④となるところが、②④③となってしまいます。

どのように組めば良いかご教授願います<(_ _)>

以下、構文です。
Dim Ap As Object
Dim M As Object
Dim buf2(3) As String
Dim strMoji As String

Set Ap = CreateObject("outlook.application")
Set M = Ap.CreateItem(0)

M.bodyFormat = 3
M.To = "aaa@com"
M.cc = "bbb@com"
M.importance = 2
M.Subject = "test"

M.body = ""
M.display

strMoji = vbCr & "住所:" & buf2(0) & vbCr & "氏名:" & buf2(1) & vbCr & _
"年齢:" & buf2(2) & vbCr
M.body = strMoji

Worksheets("sheet2").Range("A1:M10").Copy
With Ap.ActiveInspector
.wordeditor.Windows(1).Selection.Paste
End With

※メール本文でいうと、ここへbodyへ代入したテキストを入れたい(③の部分)

Worksheets("sheet2").Range("A11:I11").Copy
With Ap.ActiveInspector
.wordeditor.Windows(1).Selection.Paste
End With
Application.CutCopyMode = False

Set M = Nothing
Set Ap = Nothing

現状、調べた感じではBodyに代入された情報が新規メールが開いた後、メール本文へ出力され、数秒後、その上にSheet2で範囲コピーした２箇所が同時に貼付けられてしまいます。

代替案として、コピー2箇所しているところを1箇所に変更し、2箇所目をBodyへ組み込むことを考えました。
その場合、Bodyのフォント&カラーを変更するにはどうすれば良いかという問題が発生しました。

最初に質問させて頂いています②③④ということが出来なければ、上記の代替案で実施しようと考えてますが、その場合のフォント＆カラーをOutlookのデフォルトに関係なく、変更するにはどのようにすれば良いか、ご教示頂けましたら助かります。

以上、よろしくお願いいたします。

すべての返信 (4)

_{2014年2月14日金曜日 8:00}

yamahi23さん、こんにちは。

ソースコードをそのまま流用します。
考え方として、strMOJIを先に設定して、あとからExcelシートを貼り付けるってします。

Dim Ap As Object
Dim M As Object

Dim buf2(3) As String
Dim strMOJI As String

Set Ap = CreateObject("outlook.application")
Set M = Ap.CreateItem(0)

M.BodyFormat = 3
M.To = "aaa@com"
M.CC = "bbb@com"
M.importance = 2
M.Subject = "test"

M.body = ""
M.display

'先頭のvbCrは取りました。
strMOJI = "住所:" & buf2(0) & vbCr & "氏名:" & buf2(1) & vbCr & _
"年齢:" & buf2(2) & vbCr

'bodyには値を設定しません。bodyは書式を保持できない。

'M.body = M.body ; strMOJI

Dim objDoc As Object
'Outlookへ文字を送ります。
Set objDoc = Ap.ActiveInspector.WordEditor
objDoc.Characters.First.InsertAfter (strMOJI)

Dim i As Integer
'ここでフォントカラーを設定します。ループカウンターは、実際設定する文字数を設定します。
For i = 1 To 11
With Ap.ActiveInspector.WordEditor
With .Characters(i).Font
.Color = vbRed
End With
End With
Next i

Worksheets("sheet2").Range("A1:M10").Copy
With Ap.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

SendKeys "^{END}", True

Worksheets("sheet2").Range("A11:I11").Copy
With Ap.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

Application.CutCopyMode = False

Set M = Nothing
Set Ap = Nothing

_{2014年2月15日土曜日 7:51}

こんにちは。

「WordEditor」はWordでいうところの「Document」オブジェクトにあたりますので、Wordマクロと同様の処理でフォント設定や文字列の挿入を行うことができるかと思います。

Option Explicit

Public Sub Sample()
  Dim app As Object
  Dim doc As Object 'Documentオブジェクト(Word)
  
  Const olMailItem = 0
  Const olImportanceHigh = 2
  Const olFormatRichText = 3
  Const wdUnderlineSingle = 1
  Const wdColorAutomatic = -16777216
  
  Set app = CreateObject("Outlook.Application")
  With app.CreateItem(olMailItem)
    .Display
    .BodyFormat = olFormatRichText
    .To = "aaa@com"
    .CC = "bbb@com"
    .Importance = olImportanceHigh
    .Subject = "test"
    Set doc = .GetInspector.WordEditor
  End With
  
  'コピー&ペースト
  ActiveWorkbook.Worksheets("Sheet1").Range("A1:A10").Copy
  doc.Characters.Last.Paste
  
  '文字列挿入
  With doc.Characters.Last
    'フォント設定
    .Font.NameFarEast = "メイリオ"
    .Font.NameAscii = "メイリオ"
    .Font.NameOther = "メイリオ"
    .Font.Name = "メイリオ"
    .Font.Size = 14
    .Font.Color = vbRed
    .Font.Bold = False
    .Font.Italic = False
    .Font.Underline = wdUnderlineSingle
    .Font.UnderlineColor = wdColorAutomatic
    .InsertBefore "あいうえお" & vbCr '文字列挿入
  End With
  
  'コピー&ペースト
  ActiveWorkbook.Worksheets("Sheet2").Range("A1:A10").Copy
  doc.Characters.Last.Paste
End Sub

処理を書く際にはWordの開発者用リファレンスやマクロ記録が参考になるかと思います。

_{2014年2月17日月曜日 4:41 | 1 票}

にゃにゃお様

ご回答ありがとうございます。

結論から申しますと、自分がやりたいことは質問文の代替案で作成し、M.bodyFormat = 2（HTML）と

することで、該当箇所のフォントを＜font size=xxx＞xxxxx</font>のHTML文にて対応出来ました。

頂きました内容は、本来求めていた内容ですので、別途検;させて頂きたいと思います。

ありがとうございました。

_{2014年2月17日月曜日 4:42}

さぬあさ様