お世話になります。
色々なネットを検索して、下記のようなコードを書きました。
ただ、これだと、エクセル のデータシートが枠線なしでメールの本文に貼り付けられてしまいます。
できれば、エクセルをそのままコピー(枠線有りのスタイル)した形で貼り付けたいのですが、可能
でしょうか
おいそがしいと思いますがご指導を宜しくお願い致します。
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 = "ito_to@corporate.com"
ccStr = "ito_cc@corporate.com"
'--- 件名の内容 ---'
subjectStr = "【更新】アイテム情報の発行 " & Date & " 付分" '件名
'--- 本文の内容 ---'
'メール本文
bodyStr = bodyStr + "お疲れ様です、データ配信担当の伊藤です。" & Chr(13) & Chr(10)
bodyStr = bodyStr & Chr(13) & Chr(10)
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 = 2 ' 「3」の場合リッチテキスト型となります。「1」はテキスト型、「2」は HTML型となります。
'--- Excelワークシート ---'
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("更新日")
'--- 貼り付ける表の範囲（A1:G10のような文字列） ---'
Dim 最終行 As Integer
最終行 = Cells(Rows.Count, 1).End(xlUp).Row
Dim tableAddress As String
tableAddress = "A1:G" & 最終行
'--- メール本文に表を貼り付け ---'
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
