excel - 使用 VBA 从 Excel 发送多封带有信息作为邮件正文中的图像的 Outlook 电子邮件时出现问题

问题描述

我正在使用 Excel 文件通过 VBA 将特定信息通过电子邮件发送给收件人。

发送电子邮件后，我发送的项目中的图像在不同的电子邮件之间交换，并且不断发生。

例如，我已向收件人发送了包含与C1区域相关的数据的图像，C1并且C1收件人正确接收了它，但是我发送的项目中的数据图像并由另一个 cc 收件人接收，每次我们打开以检查它时，都会不断更改为C2, 。C3C4

发送的邮件显示 C1 的正确数据

发送邮件显示 C3 数据错误

Sub C_1()
    'Ron de Bruin, 25-10-2019
    'This macro use the function named : CopyRangeToJPG
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MakeJPG As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Sir" & "<br><br>" & _
        "Kindly find the retails performance dashboard for your reference." & "<br><br>" & _
        "Regards" & "<br>" & _
        "Manish Lengade<br>"

    'Create JPG file of the range
    'Only enter the Sheet name and the range address
    MakeJPG = CopyRangeToJPG("Sheet 1", "B2:L15")

    If MakeJPG = "" Then
        MsgBox "Something go wrong, we can't create the mail"
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
    End If

    On Error Resume Next
    With OutMail
        .To = "manish.lengade@maruti.co.in"
        .CC = ""
        .BCC = ""
        .Subject = "Retails Performance Dashboard"
        .Attachments.Add MakeJPG, 1, 1
        'Note: Change the width and height as needed
        .HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg"" width=1000 height=450></html>"
        .Display 'or use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub



Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
    'Ron de Bruin, 25-10-2019
    Dim PictureRange As Range

    With ActiveWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
        
        If PictureRange Is Nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
        
        PictureRange.CopyPicture
        With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
        End With
        .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
    End With
    
    CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
    Set PictureRange = Nothing
End Function

标签： excelvbaimageemailoutlook

excel - 使用 VBA 从 Excel 发送多封带有信息作为邮件正文中的图像的 Outlook 电子邮件时出现问题

问题描述

解决方案

推荐阅读