Question

我有一个宏可以发送一些电子邮件，但是嵌入的图像带有“ x”给接收者。

我的电子邮件有：附件，正文和嵌入的图像。

Option Explicit

Dim lsave As String


Sub Arquivoanex()

Application.DisplayAlerts = False

Dim OutApp As Object
Dim OutMail As Object
Dim oEmail As Object
Dim strBody As String

Dim line As String
Dim subject As String
Dim destine As String
Dim anex As String
Dim product As String
Dim unit As String
Dim retval As String
Dim anex_name As String
Dim validation As String
Dim signature As String

line = 3

product = "x"

Do While product <> ""

    Set oEmail = CreateObject("CDO.Message")

    product = Sheets("Send_Emails").Range("M" & line)
    unit = Sheets("Send_Emails").Range("N" & line)
    destine = Sheets("Send_Emails").Range("O" & line)
    subject = Sheets("Send_Emails").Range("P" & line)
    anex = Sheets("Send_Emails").Range("Q" & line)
    anex_name = Sheets("Send_Emails").Range("R" & line)
    validation = Sheets("Send_Emails").Range("L" & line)

    signature = "\\...\signature.png"

    Sheets("Send_Emails").Range("S1") = product

    retval = Dir(anex)

    If retval = anex_name Then

    Else
        GoTo next_anex
    End If

    If anex = "" Then
        GoTo next_anex
    End If

    Sheets("Send_Emails").Select
    ActiveSheet.Calculate

    Select Case product

        Case Is = "X"
            Sheets("X").Select
            Range("K3") = unit
            ActiveSheet.Calculate

        Case Is = "Y"
            If validation = "Send" Then
                Sheets("Y").Select
                Range("K3") = unit
                ActiveSheet.Calculate
            Else: GoTo next_anex

            End If
    End Select

    On Error Resume Next

    Call lCriarImagem 'Creates the image and give the location

    strBody = Sheets("Send_Emails").Range("B9") & "<img src=""cid:TempExportChart.bmp""height=520 width=750>" & "<br/><br/>TKS! <br/><br/></body>"

    MailItem.Attachments.Add FName, 1, 0

    With oEmail

    .Display
    oEmail.From = "mail_from@mail"
    oEmail.To = "mail_to@mail"
    oEmail.subject = subject
    oEmail.Attachments.Add FName, 1, 0
    oEmail.AddAttachment anex
    oEmail.HTMLBody = strBody & .HTMLBody

    oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "myserver.server"
    oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/authenticate") = 1
    oEmail.Configuration.Fields.Update

    oEmail.Send

    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

next_anex:

    line = line + 1

Loop

Application.DisplayAlerts = True

End Sub

是否可以使用此代码结构解决此问题？

糟糕：这是所有建议之后的代码。

我仍然遇到电子邮件中的“ X”问题：https://ibb.co/0hX6Dvf（“无法显示照片。也许文件已被移动，重命名或排除。请验证目的地是否位于正确的位置“）。

Answer 1

您需要将图像添加为文件附件，在这些附件MIME部分上设置“ content-id” MIME头，并使suire html正文通过内容ID引用图像附件（例如<img src="cid:my-xcontent-id">）

Answer 2

您需要添加图像并将其隐藏。位置0将添加并隐藏它。

MailItem.Attachments.Add Fname, 1, 0

1是Outlook常量olByValue。

添加图像后，您必须使用“ cid：FILENAME.jpg”，如下所示。例如：

With OutMail
    .To = tName   
    .Subject = "Hello world!"
    .Attachments.Add Fname, 1, 0
    .HTMLBody = "<img src=""cid:Claims.jpg""height=520 width=750>"
    .Display
End With

此外，您可以明确设置附件内容ID：

Function SendasAttachment(fName As String)

Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olAtt As Outlook.Attachments

Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(0) ' email
Set olAtt = olMsg.Attachments

Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

' attach file
olAtt.Add (fldName & fName)

Set l_Attach = olAtt.Add(fldName & fName)
Set oPA = l_Attach.PropertyAccessor
       oPA.SetProperty PR_ATTACH_MIME_TAG, "image/jpeg"
       oPA.SetProperty PR_ATTACH_CONTENT_ID, "myident"
       oPA.SetProperty PR_ATTACHMENT_HIDDEN, True

olMsg.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8514000B", True

olMsg.To = "test@somedomain.com"
msgHTMLBody = "<HTML>" & _
                   "<head>" & _
                   "</head>" & _
                   "<BODY>" & "Hi " & olMsg.To & ", <br /><br /> I have attached " & fName & " as you requested." & _
                   "<br /><img align=baseline border=1 hspace=0 src=cid:myident width='400'/>" & _
                   "</BODY></HTML>"
' send message
With olMsg
  .Subject = "Hello world!"
  .BodyFormat = olFormatHTML
  .HTMLBody = msgHTMLBody
  .Save
  '.Display
  .Send
End With

End Function

嵌入的图片未显示在电子邮件VBA中

2 个答案: