修正してみました。
※動作確認済み。
’---------------------
Sub Send_Mail()
'--- 参照設定ありの場合 ---'
Dim objOutlook As Outlook.Application
Set objOutlook = New Outlook.Application
Dim objMail As Outlook.MailItem
Set objMail = objOutlook.CreateItem(olMailItem)
Dim objTableRG As Range
Dim objWRG As Word.Range
Dim strPastePos As String
'参照設定で、Microsoft Word **.* Object Library にチェック必要
strPastePos = "＜表挿入位置＞"
'--- メールの内容を格納する変数 ---'
Dim toStr As String
Dim ccStr As String
Dim bccStr As String
Dim subjectStr As String
Dim bodyStr As String
Dim bodyStr1 As String
Dim bodyStr2 As String
'--- 宛先の内容 ---'
toStr = "testTO@test.com"
ccStr = "testCC@test.com"
'--- 件名の内容 ---'
subjectStr = "【更新】設計審査報告書の発行 " & Date & " 付DR更新分" '件名
'--- 本文の内容 ---'
'メール本文
bodyStr = bodyStr + "お疲れ様です、品管の岸本です。" & Chr(13) & Chr(10)
bodyStr = bodyStr & Chr(13) & Chr(10)
bodyStr = bodyStr + "下記のデータを修正しましたのでご確認頂けますでしょうか" & Chr(13) & Chr(10)
bodyStr = bodyStr & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 + "以上、よろしくお願いします。" & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & "■□■□■□■□■□■□■□■□■□■□■□■□" & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & "会社名" & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & "テスト事業本部 " & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & "データ配信係" & Chr(13) & Chr(10)
bodyStr2 = bodyStr2 & "■□■□■□■□■□■□■□■□■□■□■□■□" & Chr(13) & Chr(10)
bodyStr1 = bodyStr & Chr(13) & Chr(10) & "＜表挿入位置＞" & bodyStr2
'--- 条件を設定 ---'
objMail.To = toStr
objMail.cc = ccStr
objMail.Subject = subjectStr
objMail.Body = bodyStr1
objMail.BodyFormat = 3 ' 「3」の場合リッチテキスト型となります。「1」はテキスト型、「2」は HTML型となります。
'--- Excelワークシート ---'
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Data")
'--- 貼り付ける表の範囲（A1:H10のような文字列） ---'
Dim tableAddress As String
tableAddress = "A1:G7"
'--- メール本文に表を貼り付け ---'
Call ws.Range(tableAddress).Copy
objMail.GetInspector().WordEditor.Windows(1).Selection.EndKey Unit:=6, Extend:=0
Set objWRG = objMail.GetInspector.WordEditor.Range(0, 0)
objWRG.Find.Text = strPastePos
objWRG.Find.Execute
objWRG.Paste
'--- メールを表示 ---'
objMail.Display
End Sub
