Excel VBA在同一电子邮件中生成Outlook电子邮件

• “Sheet1”:(收件人信息)
• “Config”:(引用附件链接、主题行、电子邮件正文的句子等)

代码在身体中间创建嵌入图像,图像上/下带有句子。

:

我在网上研究了一下,但是找不到一个内联图像和循环的例子。

代码示例:

Sub create_emails()
Dim wb As Workbook
Dim reportsRange As Range
Dim xlCell As Range
Dim SendID
Dim Subject
Dim Body
Dim olMail As Object
Dim fileattach, ccid, wimage, sig, mimage, msub, wsub, cname, cemail, sdate, mname, mfrom, wfrom As String
Dim s1, s2, s3, s4, s5 As String
Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(0)
Set Doc = olMail.GetInspector.WordEditor
Dim oAttach As Object
Set wb = ActiveWorkbook
Set reportsRange = Range("A2", Range("A" & Cells.Rows.Count).End(xlUp))

'configuration references
s1 = wb.Sheets("Config").Range("c14").Value
s2 = wb.Sheets("Config").Range("c15").Value
s3 = wb.Sheets("Config").Range("c16").Value
s4 = wb.Sheets("Config").Range("c17").Value
s5 = wb.Sheets("Config").Range("c18").Value
fileattach = wb.Sheets("Config").Range("c3").Value
ccid = wb.Sheets("Config").Range("c4").Value
mfrom = wb.Sheets("Config").Range("c5").Value
wfrom = wb.Sheets("Config").Range("c8").Value
mimage = wb.Sheets("Config").Range("c6").Value
wimage = wb.Sheets("Config").Range("c9").Value
msub = wb.Sheets("Config").Range("c7").Value
wsub = wb.Sheets("Config").Range("c10").Value
sig = wb.Sheets("Config").Range("c11").Value

'recipient references
mname = wb.Sheets("Sheet1").Range("b2").Value
sdate = wb.Sheets("Sheet1").Range("d2").Value
cname = wb.Sheets("Sheet1").Range("c2").Value
cemail = wb.Sheets("Sheet1").Range("a2").Value

For Each xlCell In reportsRange
    If xlCell.Value <> "" Then
        With olMail
            .SentOnBehalfOfName = mfrom
            .To = SendID
            .CC = ccid
            .Subject = msub
            .Attachments.Add mimage, olByValue, 0
            .Attachments.Add sig, olByValue, 0
            .Attachments.Add fileattach
            .HTMLBody = .HTMLBody & "<font color=""#1a5276"" face=""AmplitudeTF""> Hi " & xlCell.Offset(0, 1).Value _
              & ",<br><br>We have " & xlCell.Offset(0, 2).Value & " joining your team on " & xlCell.Offset(0, 3).Value & "!<br><br>" _
              & s1 & "<br><br>" & s2 & "<br>" _
              & "<img src='cid:mon.png'" & "width='800' height='500'><br><br>" _
              & s3 & "</font><br><font face=""AmplitudeTF"" color=""#7d6608"">" & s4 _
              & "</font><font face=""AmplitudeTF"" color=""#1a5276""><br><br>Regards,<br>" _
              & "<img src='cid:gps.png'" & "<br>" _
              & s5 & "</font></span>"
            .display
        End With
    End If
Next xlCell
Set objOutlook = Nothing
End Sub