Outlook VBAでメール本文にExcel表を挿入した上でメールを作成/送信したいときはないでしょうか。
たとえば、日報など報告内容をExcelの表を張り付けてメールをしたい場合などです。
けど、そんな中で悩むことは、
・複数のメールに対してExcelの表を本文に挿入したいが方法がわからない。
ですよね。
今回はそんなお悩みを解決する
Outlook VBAでメール本文にExcelの表を挿入し作成/送信する方法について
まとめます!
もくじ
Outlook VBAでメール本文にExcelの表を挿入し作成/送信するイメージ
Outlook VBAでメール本文にExcelの表を挿入し作成/送信するイメージについて説明をします。
まず、メール本文に挿入したいExcelの表を用意します。
次にメールの宛先や件名など他の項目の内容について別シートにまとめます。
Outlook側へVBAを実装します。
メールを新規作成したいときにマクロを実行すると、
VBAに設定した内容に沿ってメールが作成され、本文へ別シートの表が挿入されます!
VBAのコードを変えると、送信もできます!
さらに、複数のメールに対してExcelの表を挿入し作成/送信することもできます!!
日常繰り返しているメール作成作業が自動化できると便利ですね。
それでは早速やってみましょう!
Excelのデータからメール本文にExcelの表を挿入し作成/送信するVBA
メールを作成するデータを用意する
Excel側にOutlookのメールを作成するデータを用意しましょう。
サンプルのデータは以下のように1シート目へA列を件名、B列を本文、C列をTo、D列をCcにしました。
件名 | 本文 | To | Cc |
---|---|---|---|
業務日報(2021年12月10日) | 宛先各位
本日の業務内容について以下の通り報告いたします。 <表挿入位置> 以上/A部タカヒロ |
user1@extan.jp | user2@extan.jp |
メール本文に挿入する表を用意する
メール本文に挿入する表を用意しましょう。
サンプルは以下のようにA列に「開始時間」、B列に「作業内容」の項目を建て値を入力しました。
VBAの処理の流れ
次にVBAの処理の流れについて説明をします。
処理の流れは以下の通りです。
①Outlook VBA→ このExcelブックのデータを表も含めてちょうだい→ Excel VBA
②Outlook VBA ←データを送るよ ←Excel VBA
③Outlook VBA →表挿入の機能ないので代わりにやって →Word VBA
④Outlook VBA ←表挿入したよ ←Word VBA
⑤Outlook VBA →メール作成/送信!
VBAの環境設定
Excelのデータからメール本文にExcelの表を挿入し作成/送信するVBAの実装方法について説明をします。
ExcelとWordのオブジェクトを使えるようにする設定を行います。
「開発」タブ>「Visual Basic」を押します。
「Visual Basic Editor」にて、[ツール] > [参照設定]をクリックし、
参照設定ウインドウが表示されたら、「Microsoft Excel **.* Object Library」と「Microsoft Word **.* Object Library」をチェックし「OK」をクリックします。
VBAの準備
今回のサンプルコードは以下の通りです。
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
'表貼り付け用定義
Dim objTableRG As Range
Dim objWRG As Word.Range
Dim strPastePos As String
'Excelのブックとワークシートのオブジェクトを設定します。
Set appExl = CreateObject("Excel.Application")
'Excelウインドウを表示させます。非表示としたい場合はFalseを設定してください。
appExl.Visible = True
'指定したExcelブックを開き、オブジェクトに設定します。パスは環境にあわせて変更してください。
Set wbBook = appExl.Workbooks.Open("C:\Users\***\Documents\***.xlsx")
'表があるシート名と範囲を指定します。
Set objSheet = wbBook.Sheets("Sheet2")
Set objTableRG = objSheet.Range("A1:B6")
'表貼り付けの位置となる文字列を指定します。""内の文字列は適宜変更してください。
strPastePos = "<表挿入位置>"
'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表貼り付け処理----ここから
'本文に表貼り付けの位置を示す文字があるかチェックします。
If InStr(.Body, strPastePos) Then
'Excel表をコピーします。
objTableRG.Copy
'メールアイテムをWordEditor経由で編集します。
Set objWRG = .GetInspector.WordEditor.Range(0, 0)
'対象位置の文字列を選択します。
objWRG.Find.Text = strPastePos
objWRG.Find.Execute
'予定表本文へ貼り付けます。
objWRG.Paste
End If
'Excel表貼り付け処理----ここまで
'宛先が空欄であるか判定します。
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 objTableRG = Nothing
Set objWRG = Nothing
MsgBox "Outlookメールの作成が完了しました!", vbInformation
End Sub
VBAの設定
VBAの設定をおこないましょう。
前回のVBAにExcelブックを開いて値を取得するメソッドを追加していますので、
Excelブックのパスを設定する必要があります。
以下のパスを作成したExcelブックのものへ変更してください。
Set wbBook = appExl.Workbooks.Open("C:\Users\***\Documents\***.xlsx")
表があるシート名と範囲を指定します。”A1:B6″の範囲は表にあわせて変更してください。
Set objSheet = wbBook.Sheets("Sheet2")
Set objTableRG = objSheet.Range("A1:B6")
表貼り付けの位置となる文字列を指定します。””内の文字列は適宜変更してください。
strPastePos = "<表挿入位置>"
本文のフォーマットを指定します。
「3」の場合リッチテキスト型となります。「1」はテキスト型、「2」は HTML型となります。
.BodyFormat = 3
VBAの実装手順
実装手順は以下の通りです。
「開発」タブ>「Visual Basic」を押します。
「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] の ThisOutlookSessionをダブルクリックします。
右ペインのコードエリアへ、VBAコードを貼り付けて保存します。
こちらで完了です。
VBAの実行
VBAを実行してみましょう。
まずはメールが作成されるか確認をします。
「”Outlookメールの作成が完了しました!”」と表示されたら完了です。
作成されたメールを確認してみましょう。
はい、件名、宛先、本文に指定した値とさらに表が挿入されていますね!
つづいて送信をしてみましょう。
.Send
のコメントを外し、Sendメソッドを有効化します。
実行してみましょう。
はい、送信されていますね!
VBAの説明
新規にアイテムを作成し、オブジェクトにセットします。
Set objMail = CreateItem(olMailItem)
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
件名を指定します。
.Subject = wsSheet.Cells(i, 1)
本文を指定します。
.Body = wsSheet.Cells(i, 2)
Toを指定します。
.To = wsSheet.Cells(i, 3)
CCを指定します。
.CC = wsSheet.Cells(i, 4)
本文に表貼り付けの位置を示す文字があるかチェックします。
If InStr(.Body, strPastePos) Then
Excel表をコピーします。
objTableRG.Copy
メールアイテムをWordEditor経由で編集します。
Set objWRG = .GetInspector.WordEditor.Range(0, 0)
対象位置の文字列を選択します。
objWRG.Find.Text = strPastePos
objWRG.Find.Execute
予定表本文へ貼り付けます。
objWRG.Paste
メールを表示します。
.Display
メールを送信します。
'.Send
Excelのデータから複数のメール本文にExcelの表を挿入し作成/送信するVBA
次はExcelのデータから複数のメール本文にExcelの表を挿入し作成/送信するVBAについて説明をします。
複数メールを作成するデータを用意する
Excel側にOutlookのメールを作成するデータを用意しましょう。
以下のように1シート目へ1行増やして2行にしA列を件名、B列を本文、C列をTo、D列をCcに値を入力します。
VBAの実行
VBAを実行してみましょう。
「”Outlookメールの作成が完了しました!”」と表示されたら完了です。
作成されたメールを確認してみましょう。
複数のメールが作成されていますね!
Sendメソッドを有効化しメールを送信してみましょう。
はい、送信されていますね!
さいごに
いかがでしょうか。
今回は、
Outlook VBAでメール本文にExcelの表を挿入し作成/送信する方法について
まとめました。
また、他にも便利な方法がありますので、よろしければご参照頂ければと思います。
チェックは入っています
作業シートのデータのある範囲を指定して メールに張り付け
‘表があるシート名と範囲を指定します。
Set objSheet = wbBook.Sheets(“作業”)
Set objTableRG = objSheet.Range(“A1:B6”)←ここをデータがある範囲に指定したいです(データー量が決まっていないので)。
‘表貼り付けの位置となる文字列を指定します。””内の文字列は適宜変更してください。
strPastePos = “<表挿入位置>”
このあと ‘Excel表貼り付け処理—-ここから から ‘Excel表貼り付け処理—-ここまで を貼り付けました
データがある範囲を可変的に取得する方法については以下の記事にまとめましたのでご参考ください。
https://extan.jp/?p=9252
コードは以下の通りです。
■変更前
Set objTableRG = objSheet.Range(“A1:B6”)←ここをデータがある範囲に指定したいです(データー量が決まっていないので)。
■変更後
lastRow = objSheet.Cells(objSheet.Rows.Count, 1).End(xlUp).Row
lastCol = objSheet.Cells(1, objSheet.Columns.Count).End(xlToLeft).Column
Set objTableRG = objSheet.Range(objSheet.Cells(1, 1), objSheet.Cells(lastRow, lastCol))
お世話になります
メールにExcelの表を貼付け 今までメール送信ができていたのですが、
急にエラーがでてメール表貼付け及びメール送信ができなくなりました
エラー画面がでて
‘メールアイテムをWordEditor経由で編集します。
Set objWRG = .GetInspector.WordEditor.Range(0, 0)
ここで引っかかります
教えていただけたらと思います
いつもご利用ありがとうございます。
メール表貼付け及びメール送信ができなくなった件につきまして、
WordEditorのところでエラーとなっていることから、参照設定で
「Microsoft Word **.* Object Library」にチェックが入り有効になっているか
ご確認いただけますでしょうか。