VBA для отправки Excel 2016 Диапазон в виде JPG в теле - не отображается - PullRequest
0 голосов
/ 08 марта 2019

Я использую следующий код для выбора диапазона в 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...