无法将多个图像添加到电子邮件中

时间:2015-10-28 20:43:54

标签: excel vba email hyperlink

我有一封通过Excel使用VBA生成的电子邮件。该电子邮件包括电子邮件正文中的两个嵌入图片以及指向他们所引用视频的单独超链接。问题是它没有识别第二张图片而只是将相同的图片嵌入两次,但超链接是正确的。以下是我的代码示例:

Private Sub SubmitBtn_Click()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim MemNme As String, Email As String, UsrName As String, domainID As String, pic As String, pic2 As String
Dim Hlink As String, Hlink2 As String
State = Screener.StateBox
 If State = "California" Then
        If Screener.MktPlcBox = True Then
            pic = "websitewithpicture1"
            Hlink = "videolink"
            count = 1
        End If
        If Screener.SubsidyBox = True Then
            pic2 = "websitewithpicture2"
            Hlink2 = "videolink"
            count = 2
        End If
With OutMail
            .To = Email
            .CC = ""
            .BCC = ""
            .Subject = "Helpful Video"
            .HTMLBody = "Dear " & MemNme & ",<br><br>" _
            & vbNewLine & vbNewLine & "Thank you for speaking with me today about your plan. You have a lot of choices, " _
            & " and <b>we appreciate you choosing company</b>. Helping you understand your plan is important to us and I thought this video would be valuable to you.<br><br>" _
            & vbNewLine & "<center><a href=" & Hlink & "<img src=cid:" & Replace(pic, " ", " ", "520") & " height =250 width=400></a>" _
            & "<a href=" & Hlink2 & "<img src=cid:" & Replace(pic2, " ", " ", "420") & " height =250 width=400></a></center><br>" _
            & vbNewLine & vbNewLine & "You can always get additional information at <b>website.com</b> or by calling the number on the back of your card.<br><br>" _
            & vbNewLine & vbNewLine & "Thank you,<br>" _


 & vbNewLine & UsrName 

        .Attachments.Add pic, olByValue, 0
        .Attachments.Add pic2, olByValue, 0 <--------It doesn't "See" this pic???
'            MsgBox "Press ok to create your e-mail"
        .Display  'or use .Send
    End With
    On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
Unload Me
End Sub

0 个答案:

没有答案