使用VBA在Outlook Body中發送帶有PNG圖像的電子郵件

Question

在對互聯網進行深入研究之后，我能夠構建以下代碼：

Sub EmailSuccess()

    Dim OutlookApplication As Outlook.Application
    Dim OutlookMailItem As Outlook.MailItem

    Dim Recipients As Object
    Dim myRecipients As Outlook.Recipient
    Dim sTo As Object
    Dim CCs As Object
    Dim myCCs As Outlook.Recipient
    Dim sCc As Object
    Dim emailContent As String

    Dim OutDocSto As String
    Dim ArchiveLinks As String
    Dim KendoxDocs As String
    Dim LinksGE As String
    Dim PicSheet2 As Object
    Dim PicSheet3 As Object

    Application.ScreenUpdating = False

    Set OutlookApplication = New Outlook.Application
    Set OutlookMailItem = OutlookApplication.CreateItem(0)

    '=========================================START========================================='

        Workbooks("ConfigFile_Kendox Monitoring.xlsm").Activate
        Sheets("Email").Activate

        'Set Recipient value
        Range("A2").Select
            Set Recipients = Range(ActiveCell, ActiveCell.End(xlDown))

        'Set CC Value
        ActiveCell.Offset(0, 1).Select
            Set CCs = Range(ActiveCell, ActiveCell.End(xlDown))

        'Set greetings
        emailContent = "<b>" & Range("D2").Value & "</b>" & "<br>" & "<br>" & _
            Range("D3").Value & "<br>" & "<br>" & Range("D4").Value & "<br>" & "<br>"

        'Copy Outbound Document Storage screenshot path
        Range("I2").Select
            OutDocSto = ActiveCell.Value

        'Copy Archive Links screenshot path
        ActiveCell.Offset(0, 1).Select
            ArchiveLinks = ActiveCell.Value

        'Assign value for KendoxDocs
        KendoxDocs = "<b>" & "<u>" & Range("D5").Value & "</b>" & "</u>" & "<br>" & "<br>"

        'Assign value for LinksGE
        LinksGE = "<br>" & "<br>" & "<b>" & "<u>" & Range("D6").Value & "</b>" & "</u>" & "<br>" & "<br>"


        'Delete contents for Sheet2
        Sheets("OutDocStorage").Activate
        For Each PicSheet2 In ActiveSheet.Pictures
            PicSheet2.Delete
        Next PicSheet2

        'Insert OutDocSto in OutDocSto sheet
        Sheets("OutDocStorage").Activate
        Range("A1").Select
        ActiveSheet.Pictures.Insert (OutDocSto)

        'Delete contents for Sheet3
        Sheets("ArchiveLinks").Activate
        For Each PicSheet3 In ActiveSheet.Pictures
            PicSheet3.Delete
        Next PicSheet3

        'Insert ArchiveLinks in ArchiveLinks sheet
        Worksheets("ArchiveLinks").Activate
        Range("A1").Select
        ActiveSheet.Pictures.Insert (ArchiveLinks)

        'Set value for eBodyODS
        Sheets("OutDocStorage").Activate
            Set eBodyODS = ThisWorkbook.Sheets("OutDocStorage").UsedRange

        'Set value for eBodyArcLinks
        Sheets("ArchiveLinks").Activate
            Set eBodyArcLinks = ThisWorkbook.Sheets("ArchiveLinks").UsedRange


        On Error Resume Next

            With OutlookMailItem

                .Display

                'Assign Recipients in TO field
                For Each sTo In Recipients
                    Set myRecipients = OutlookMailItem.Recipients.Add(sTo)
                    myRecipients.Type = olTo

                    myRecipients.Resolve
                    If Not myRecipients.Resolved Then
                        myRecipients.Delete
                    End If

                Next sTo

                'Assign CCs in CC field
                For Each sCc In CCs
                    Set myCCs = OutlookMailItem.Recipients.Add(sCc)
                    myCCs.Type = olCC

                    myCCs.Resolve
                    If Not myCCs.Resolved Then
                        myCCs.Delete
                    End If

                Next sCc

                'Assign value for Subject
                .Subject = Workbooks("ConfigFile_Kendox Monitoring.xlsm").Sheets("Email").Range("C2").Value

                'Set Body
                .HTMLBody = emailContent & KendoxDocs & "<img src = OutDocSto>" & LinksGE & "<img src = ArchiveLinks>"

                .Display


            End With

        On Error GoTo 0

        Set OutlookMailItem = Nothing
        Set OutlookApplication = Nothing
        Application.ScreenUpdating = True

End Sub

預期此代碼會將PNG照片附加到我的Outlook電子郵件正文中。 這兩張照片的路徑在OutDocSto和ArchiveLinks字符串中聲明。 但是，它沒有得到我期望的結果。 嵌入照片可能是最簡單的方法。 謝謝

Answer 1

我相信如果您編輯代碼：

HTMLBody = emailContent & KendoxDocs & "<img src = OutDocSto>" & LinksGE & "<img src = ArchiveLinks>"

為此，它可能會完成以下任務：

HTMLBody = emailContent & KendoxDocs & "<img src ='" &  OutDocSto & "'>" & LinksGE & "<img src ='" &  ArchiveLinks & "'>"