Я использую следующий код для выбора диапазона в Excel 2016, преобразования его в JPG и вставки в текст сообщения электронной почты, отправляемого с помощью Outlook 2016. Я получаю ответы от получателей, что изображение отсутствует в теле сообщения электронной почты.,Я отправил BCC сам на отправку, и изображение показывается на моем электронном письме при получении, но тестирование его на мою личную электронную почту outlook.com приводит к тому же результату без изображения.
Может кто-нибудь посоветовать по этому вопросуи выпрямление?
Sub Send_Email_Store()
Dim TempFilePath As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xHTMLBody As String
Dim xRg As Range
On Error Resume Next
Set xRg = Sheets("Summary Report").Range("a1:m69")
If xRg Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
TempFilePath = Environ$("temp") & ""
xHTMLBody = "Hi Gav," & "<br>" & _
"Please see the following QTD Summary in your Business, up until last week."
& "<br>" & _
"If you have any questions, let me know." _
& "<br><br><br>" _
& "<img src='cid:DashboardFile.jpg'>"
With xOutMail
.Subject = "QTD Overview"
.HTMLBody = xHTMLBody
.Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0
.To = "gavrog@hotmail.com"
.Cc = ""
.Bcc = "me.com"
.Display
End With
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
Dim xRgPic As Range
ThisWorkbook.Activate
Worksheets(SheetName).Activate
Set xRgPic = ThisWorkbook.Worksheets("Summary Report").Range(xRgAddrss)
xRgPic.CopyPicture
With ThisWorkbook.Worksheets("Summary Report").ChartObjects.Add(xRgPic.Left,
xRgPic.Top, xRgPic.Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "" & nameFile & ".jpg", "JPG"
End With
Worksheets("Summary Report").ChartObjects(Worksheets("Summary
Report").ChartObjects.Count).delete
Set xRgPic = Nothing
End Sub