Sub Outlookのメールを新規作成する_Excelデータと書式を取得()
'Outlook用の定義
Dim objMail As Object
'Excel用の定義
Dim appExl As Excel.Application
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
'Excelのブックとワークシートのオブジェクトを設定します。
Set appExl = CreateObject("Excel.Application")
'Excelウインドウを表示させます。非表示としたい場合はFalseを設定してください。
appExl.Visible = True
'指定したExcelブックを開き、オブジェクトに設定します。パスは環境にあわせて変更してください。
Set wbBook = appExl.Workbooks.Open("C:\Users\***\Documents\***.xlsx")
'Excelブック1シート目をオブジェクトに設定します。
Set wsSheet = wbBook.Worksheets(1)
'取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
If MsgBox("Outlookメールを作成しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
'一覧の件数分繰り返します。
For i = lnContactCount To wsSheet.Cells(1, 1).End(xlDown).Row
'メールを作成します。
Set objMail = CreateItem(olMailItem)
With objMail
.BodyFormat = 3 ' 「3」の場合リッチテキスト型となります。「1」はテキスト型、「2」は HTML型となります。
.Subject = wsSheet.Cells(i, 1) '件名を指定します。
'.Body = wsSheet.Cells(i, 2) '本文を指定します。
.To = wsSheet.Cells(i, 3) 'Toを指定します。
.CC = wsSheet.Cells(i, 4) 'CCを指定します。
'Excel本文項目をコピーします。
wsSheet.Cells(i, 2).Copy
'メールアイテムをWordEditor経由で編集します。
Set objWRG = .GetInspector.WordEditor.Range(0, 0)
'予定表本文へExcelの書式付で貼り付けます。
objWRG.PasteExcelTable False, False, False
'宛先が空欄であるか判定します。
If wsSheet.Cells(i, 3) = "" Then
.Display 'メールを表示します。
Else
.Display 'メールを表示します。
'.Send 'メールを送信します。
End If
End With
Next
Else
MsgBox "処理を中断します"
End If
'Excelウインドウを閉じます。
appExl.Quit
'オブジェクトを解放します。
Set olItem = Nothing
Set wbBook = Nothing
Set wsSheet = Nothing
Set objWRG = Nothing
MsgBox "Outlookメールの作成が完了しました！", vbInformation
End Sub
VBAの設定
VBAの設定をおこないましょう。
以下のパスを作成したExcelブックのものへ変更してください。
Set wbBook = appExl.Workbooks.Open("C:\Users\***\Documents\***.xlsx")
Sub Outlookのメールを新規作成する_Excelデータと書式を取得_修正版()
'Outlook用の定義
Dim objMail As Outlook.MailItem
Dim objOutlook As Outlook.Application
Dim objWRG As Word.Range ' Wordの範囲オブジェクトの宣言
'Excel用の定義
Dim appExl As Excel.Application
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
'ループ用変数
Dim i As Long
'Outlookアプリケーションを開始します。
Set objOutlook = New Outlook.Application
'Excelのブックとワークシートのオブジェクトを設定します。
Set appExl = CreateObject("Excel.Application")
appExl.Visible = True
Set wbBook = appExl.Workbooks.Open("E:\temp\テンプレ.xlsx")
Set wsSheet = wbBook.Worksheets(1)
lnContactCount = 2
If MsgBox("Outlookメールを作成しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
For i = lnContactCount To wsSheet.Cells(1, 1).End(xlDown).Row
Set objMail = objOutlook.CreateItem(Outlook.olMailItem)
With objMail
.BodyFormat = Outlook.OlBodyFormat.olFormatRichText
.Subject = wsSheet.Cells(i, 1)
.To = wsSheet.Cells(i, 3)
.CC = wsSheet.Cells(i, 4)
wsSheet.Cells(i, 2).Copy
Set objWRG = .GetInspector.WordEditor.Range(0, 0)
objWRG.PasteExcelTable False, False, False
If wsSheet.Cells(i, 3) = "" Then
.Display
Else
.Display
End If
End With
Next i
Else
MsgBox "処理を中断します"
End If
appExl.Quit
Set wbBook = Nothing
Set wsSheet = Nothing
Set objWRG = Nothing
Set objMail = Nothing
Set objOutlook = Nothing
MsgBox "Outlookメールの作成が完了しました！", vbInformation
End Sub
修正箇所
コードの修正箇所は以下の通りです。
・i はループのための変数として Long 型で宣言
・objWRG は Word の Range オブジェクトとして宣言
・objOutlookをOutlook.Application オブジェクトとして宣言
・Set olItem = Nothing を削除
さいごに
いかがでしょうか。
今回は、 Outlook VBAでExcelで設定したデータと書式でメールを作成/送信する方法について
まとめました。
VBAでOutlookメール本文の一部を抽出しExcelへ出力する方法！
【Outlook VBA】Excelから文字サイズ/色/種類/書式を指定しメールを作成/送信する方法！
【VBA】Excelから複数・多種類のOutlookのメールを作成・送信する方法
Power Appsでメール送信する方法！複数宛先やCC設定も！
【Outlook VBA】転送メールを作成する方法！宛先追加や件名・本文追記も！
VBAでOutlookメール本文の情報をExcelに取り込む方法
【Outlook VBA】受信トレイの添付ファイルを一括保存する方法！期間指定も！
【Outlook VBA】メール本文を改行する方法！改行されない対処法も！
度々、利用させて頂いております。
私も、↑上記の井上正文様と同様にobjWRGで止まってしまいます。
Outlookに実装しており、参照設定も確認しましたが、、、
思ったのは、objWRGの宣言が無いのかな？と。
不躾な質問で恐縮ですが、御教示願います。
いつもご利用ありがとうございます。
objWRGで止まる件につきまして、「Microsoft Word **.* Object Library」の参照設定がチェックされていないと発生いたしますので、
今一度ご確認頂きたくお願いいたします。
※オブジェクトはC:\Program Files\Microsoft Office\root\Office**\MSWORD.OLBにございます。
また、宣言が抜けている件については申し訳ありません。
修正版を追記させていただきましたので、こちらで試していただきたくお願いいたします。
https://extan.jp/?p=6656#%EF%BC%9C%E8%BF%BD%E5%8A%A0%EF%BC%9E%E4%BF%AE%E6%AD%A3%E7%89%88VBA%E3%82%B3%E3%83%BC%E3%83%89
本文に色を付けているのですが、出来上がったメールは色が付きません。「Microsoft Excel **.* Object Library」と「Microsoft Word **.* Object Library」も参照するよう設定していますし、出来上がったメールはリッチテキストになっています。何か考えられる原因はありますでしょうか。（F8でひとつずつ実行すると、Microsoft Wordが起動しているように見えないのは気になっています。）
いつもご利用ありがとうございます。
メールに色がつかない件ですが、
Excel側の別のセルの値を参照してしまっている可能性がありますので、
複数行ある場合は1件のみにし再度確認抱けますでしょうか。
あとは当方の検証で使用しているOfficeのバージョンは2016以降ですが、
バージョンによる挙動の違いがある可能性がありますので
2016以降のバージョンであるかご確認いただきたくお願いいたします。
なお、Wordが起動しない件について編集機能のみ利用しているため
実行してもWord本体は立ち上がりませんので問題はありません。
お世話になります。 試しに丸ごとコピーして使ってみましたが、 色々エラーでout lookが立ち上がりません。 現在
Set objWRG = .GetInspector.WordEditor.Range(0, 0)で止まってしまいます。何かアドバイスが有りませんか？
いつもご利用ありがとうございます。
まず、VBAを実装先はOutlookであるかご確認頂き、
併せて、以下ページをご参考の上、
「Microsoft Excel **.* Object Library」と「Microsoft Word **.* Object Library」の参照設定がされているかご確認頂きたくお願いいたします。
https://extan.jp/?p=6656#VBA%E3%81%AE%E7%92%B0%E5%A2%83%E8%A8%AD%E5%AE%9A