У меня есть код ниже, который отправляет электронные письма из файла Excel. Моя текущая проблема заключается в том, что при получении с помощью кода изображения в строке не отображаются на получающем электронном письме.
Если я вручную нажму «Отправить», он отобразит его, но если будет создано более 80 черновиков электронной почты, Outlook завершится сбоем.
Любая помощь будет оценена.
Sub SendEmail()
Dim outlookApp As Object
Dim outlookMail As Object
Dim sigString As String
Dim Signature As String
Dim insertPhoto As String
Dim photoSize As String
Set outlookApp = CreateObject("Outlook.Application")
Set outlookMail = outlookApp.CreateItem(0)
'Change only Mysig.htm to the name of your signature
sigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(sigString) <> "" Then
Signature = GetBoiler(sigString)
Else
Signature = ""
End If
insertPhoto = "C:\Users\store\Desktop\Presale.jpg" 'Picture path
photoSize = "<img src=""cid:Presale.jpg""height=400 width=400>" 'Change image name here
emailMessage = "<BODY style=font-size:11pt;font-family:Calibri>Dear " & titleName & " " & fullName & "," & _
"<p>I hope my email will find you very well." & _
"<p>Our <strong>sales preview</strong> starts on Thursday the 22nd until Sunday the 25th of November." & _
"<p>I look forward to welcoming you into the store to shop on preview.<p>" & _
"<p> It really is the perfect opportunity to get some fabulous pieces for the fast approaching festive season." & _
"<p>Please feel free to contact me and book an appointment." & _
"<p>I look forward to seeing you then." & _
"<p>" & photoSize & _
"<p>Kind Regards," & _
"<br>" & _
"<br><strong>My Name</strong>" & _
"<br>Assistant Store Manager" & _
"<p>"
With outlookMail
.To = clientEmail
.CC = ""
.BCC = ""
.Subject = "PRIVATE SALE | IN STORE"
.BodyFormat = 2
.Attachments.Add insertPhoto, 1, 0
.HTMLBody = emailMessage & Signature 'Including photo insert and signature
.Importance = 2
.ReadReceiptRequested = True
.Display
'.Send 'this will send the email without review / not showing picture inserted
End With
Set outlookApp = Nothing
Set outlookMail = Nothing
End Sub