エクセルVBAでOutlookメール作成

いろいろ検索や質問をしてエクセルVBAで、下記のコードによりOutlookのメールを自動作成できるようになりました。

Sub TEST01()
Set oApp = CreateObject("Outlook.Application")
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0
strMOJI = "こんにちは！" & vbNewLine & "テストメールです。" & vbNewLine & "よろしくおねがいします。"
objMAIL.To = "[e-mail]" '宛先
objMAIL.Subject = "テスト" '件名
objMAIL.Body = strMOJI '本文の代入
objMAIL.display '表示
End Sub

それで、実際にはstrMOJI に代入した文字列の下に、このマクロを記述してあるBOOKのSheets("Sheet1").Range("A1:D10")をコピーし、
「リッチテキスト形式」で貼り付けたいのです。
どのようなコードに変えればよいのか教えていただけると助かります。
よろしくお願いいたします。

No.3 ベストアンサー 回答者： end-u 回答日時： 2012/08/16 19:51

>ただ、マクロを2回以上走らせると、その都度いくつもOutlookが立ち上がってしまいます。

>これは解消できますか？
それは前回QAで手当て済みだったんですけどね。

Dim oApp　　　 As Object
Dim objMAIL　　As Object
Dim strMOJI(1) As String
Dim n　　　　　As Long

On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
　　Set oApp = CreateObject("Outlook.Application")
　　oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
End If

Set objMAIL = oApp.CreateItem(0)
strMOJI(0) = "こんにちは！" & vbCrLf & _
　　　　　　 "テストメールです。" & vbCrLf & _
　　　　　　 "よろしくおねがいします。" & vbCrLf
strMOJI(1) = "以上です。" & vbCrLf & _
　　　　　　 "EMAX株式会社" & vbCrLf & _
　　　　　　 "Emax"
objMAIL.To = "E-Mail_Address_Here"
objMAIL.Subject = "テスト"
objMAIL.BodyFormat = 2 'HTML形式
objMAIL.Body = strMOJI(0) & strMOJI(1)
objMAIL.display

n = Len(strMOJI(0))
ActiveSheet.Range("A1:D10").Copy
oApp.ActiveInspector.WordEditor.Range(n, n).Paste
Application.CutCopyMode = False

Set objMAIL = Nothing
Set oApp = Nothing

BodyFormatはHTML形式じゃないと書式が維持できないような感じです。
#バージョン、もしくは受信側のメーラーによるかもしれませんけど..

この回答へのお礼

何から何までありがとうございます。
わからないことだらけですが、やりたいことができました。
感謝いたします。
これからもご指導賜りますようお願い申し上げます。

お礼日時：2012/08/17 17:58

No.2 回答者： end-u 回答日時： 2012/08/16 17:03

>なお、エクセルのバージョンは2010、Outlookは2007です。

EnvelopeVisibleプロパティは同一バージョンでないとエラーになるようです。（by Google君）
次案ですが、Sendkeysはトばして..Outlookのオプションの「メール形式」のところで
「電子メールの編集に..Word..を使用する..」的なチェックがあったらチェック入れておいて下記試してみて下さい。
#Outlook2007持ってないのでアヤフヤ

Dim oApp　　As Object
Dim objMAIL As Object
Dim strMOJI As String

Set oApp = CreateObject("Outlook.Application")
oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
Set objMAIL = oApp.CreateItem(0)
strMOJI = "こんにちは！" & vbNewLine & _
　　　　　"テストメールです。" & vbNewLine & _
　　　　　"よろしくおねがいします。" & vbNewLine
objMAIL.To = "E-Mail_Address_Here"
objMAIL.Subject = "テスト"
objMAIL.BodyFormat = 3
objMAIL.Body = strMOJI
objMAIL.display
ActiveSheet.Range("A1:D10").Copy
With oApp.ActiveInspector.WordEditor.Range
　　.Collapse 0
　　.Paste
End With
Application.CutCopyMode = False
Set objMAIL = Nothing
Set oApp = Nothing

この回答へのお礼

ありがとうございます。
すごいです！

> 「電子メールの編集に..Word..を使用する..」的なチェックがあったらチェック入れておいて

見当たらないのでなにもしませんでしたがちゃんと出来ました。
ただ、マクロを2回以上走らせると、その都度いくつもOutlookが立ち上がってしまいます。
これは解消できますか？
また、ここまでできると欲が出てしまいました。
下記のように文字列の変数を2つもち、セル範囲を貼り付けた下にも文字列 strMOJI(1) を入れることは可能でしょうか？
勝手なことばかり言って申し訳ありません。

Sub twst02()
Dim oApp As Object
Dim objMAIL As Object
Dim strMOJI(1) As String

Set oApp = CreateObject("Outlook.Application")
oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
Set objMAIL = oApp.CreateItem(0)
strMOJI(0) = "こんにちは！" & vbNewLine & _
"テストメールです。" & vbNewLine & _
"よろしくおねがいします。" & vbNewLine
strMOJI(1) = "以上です" & vbNewLine & _
"EMAX株式会社" & vbNewLine & _
"Emax"
objMAIL.To = "E-Mail_Address_Here"
objMAIL.Subject = "テスト"
objMAIL.BodyFormat = 3
objMAIL.Body = strMOJI(0)
objMAIL.display
ActiveSheet.Range("A1:D10").Copy
With oApp.ActiveInspector.WordEditor.Range
.Collapse 0
.Paste
End With
Application.CutCopyMode = False
Set objMAIL = Nothing
Set oApp = Nothing
End Sub

お礼日時：2012/08/16 18:10

No.1 回答者： end-u 回答日時： 2012/08/16 13:46

HTML形式ではダメなんでしょうか。

こちらにサンプルが載ってますし
『Excel 2002 または Excel 2003 で Visual Basic for Applications を使用して電子メール メッセージでセル範囲を送信する方法』
http://support.microsoft.com/kb/816644/ja

上記例のままでも[この選択範囲を送信する]で送信。
必要なら新規Bookにコピーするように変更したり。
Sub try()
　　Dim r As Range
　　Set r = ActiveSheet.Range("A1:D10")
　　With Workbooks.Add(xlWBATWorksheet)
　　　　.EnvelopeVisible = True
　　　　With .Sheets(1)
　　　　　　With .MailEnvelope
　　　　　　　　.Introduction = "こんにちは！" & vbNewLine & "テストメールです。" & vbNewLine & "よろしくおねがいします。"
　　　　　　　　.Item.To = "E-Mail_Address_Here"
　　　　　　　　.Item.Subject = "テスト"
　　　　　　　　'.Item.Send
　　　　　　End With
　　　　　　r.Copy .Range("A1")
　　　　End With
　　End With
End Sub

他には
・不安定だけど妥協してSendkeysを使う。
・（Outlookメール編集にWordを使っている場合）OutlookのActiveInspector.WordEditor.Range.Pasteメソッドを使う。
・セル範囲をhtm形式に吐き出してHTMLBodyに読み込む。（HTML形式メール）
・Win32API関数を使ってクリップボードからHTML Formatを取り出してHTMLBodyに読み込む。（HTML形式メール）
などが考えられない事もないです。

この回答へのお礼

end-uさん、前回もありがとうございました。
今回もさっそくありがとうございます。

試してみましたが、参考URLのものも、end-uさんご提示のものも

.EnvelopeVisible = True

のところで実行時エラー1004「EnvelopeVisibleメソッドは失敗しました。Workbookオブジェクト」となります。
なお、エクセルのバージョンは2010、Outlookは2007です。

> HTML形式ではダメなんでしょうか

貼り付けたあと、編集が可能ならOKです。

お礼日時：2012/08/16 14:36