Excel VBA 、Outlookにて自動メール作成についてご質問です。

Excel VBA 、Outlookにて自動メール作成についてご質問です。 以下、自分で作ってみたコードです。 コードの後に、助けて頂きたいことがございます。 ~~~~~~~~~~~~~ Sub SendEmail() Dim objOutlook As Outlook.Application Dim i Dim rowMax As Long Dim wsList As Worksheet Dim wsMail As Worksheet Dim objMail As Outlook.MailItem Set objOutlook = New Outlook.Application Set wsList = ThisWorkbook.Sheets("送信先") Set wsMail = ThisWorkbook.Sheets("内容") With wsList rowMax = .Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To rowMax Set objMail = objOutlook.CreateItem(olMailItem) With objMail .To = wsList.Cells(i, 4).Value .Subject = "ご無沙汰しております。" .BodyFormat = olFormatPlain .Body = wsList.Cells(i, 1).Value & vbCrLf & _ wsList.Cells(i, 2).Value & " " & _ wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & _ wsMail.Cells(1, 1).Value .Display End With Next i End With End Sub ~~~~~~~~~~~~ 下記、文章の間※(ココ)の所に、 C:\Users\○○○\Desktop\.png(一部削除してます。)デスクトップにあるpng画像を嵌め込み、メールにすることなんてできるのでしょうか? 「 今年は、新型コロナに加え、災害もあり、大変な年になっております。 (ココ) お仕事以外のことでも構いません。 」 助けていただけたら幸いです。 よろしくお願いいたします。

画像

Visual Basic | メール54閲覧

ベストアンサー

0

リッチテキスト形式の場合です。 デスクトップの"test.png"を挿入します。 太字や赤字も出来ます。 Sub SendEmail() Const wdAuto = 0 Const wdRed = 6 Dim objOutlook As Outlook.Application Dim i Dim rowMax As Long Dim wsList As Worksheet Dim wsMail As Worksheet Dim objMail As Outlook.MailItem Set objOutlook = New Outlook.Application Set wsList = ThisWorkbook.Sheets("送信先") Set wsMail = ThisWorkbook.Sheets("内容") With wsList rowMax = .Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To rowMax Set objMail = objOutlook.CreateItem(olMailItem) With objMail .To = wsList.Cells(i, 4).Value .Subject = "ご無沙汰しております。" .BodyFormat = olFormatPlain .BodyFormat = olFormatRichText 'メールの形式(リッチテキスト) Dim file As String file = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\test.png" .Display With .GetInspector.WordEditor.Windows(1).Selection 'Selection オブジェクト .TypeText "今年は、新型コロナに加え、災害もあり、大変な年になっております。 " & vbCrLf .InlineShapes.AddPicture Filename:=file '画像挿入 .TypeText vbCrLf .TypeText "お仕事以外のことでも構いません。 " & vbCrLf .Font.Bold = True .TypeText "太字です" & vbCrLf .Font.Bold = False .TypeText "普通です" & vbCrLf .Font.ColorIndex = wdRed .TypeText "赤字です" & vbCrLf .Font.ColorIndex = wdAuto .TypeText "自動(黒字)です" & vbCrLf .TypeText vbCrLf .Font.ColorIndex = wdRed .Font.Bold = True .TypeText "太字の赤字です" & vbCrLf End With '.Send End With Next i End With End Sub

画像

早速返信頂きありがとうございます! すぐに試してみたのですが、下記の所で問題となります。 僕の知識不足のせいですが、また助けていただけたら幸いです。 .InlineShapes.AddPicture Filename:=file '画像挿入 デバッグになります。 「今年は、新型コロナに加え、災害もあり、大変な年になっております。」 この文章のみしか表示されません。 (画像も表示されません。) .Body = wsList.Cells(i, 1).Value & vbCrLf & _ wsList.Cells(i, 2).Value & " " & _ wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & _ wsMail.Cells(1, 1).Value お客様を表示するので、消したくないです。

ThanksImg質問者からのお礼コメント

迅速な対応ありがとうございます。 貴方様に出会えたこと感謝いたします。

お礼日時:9/24 11:48

その他の回答(1件)