首页 > 解决方案 > 在电子邮件中插入链接(来自单元格)作为图像

问题描述

我正在尝试为客户创建电子邮件并嵌入链接到网站的图像。每个客户的链接会有所不同,但链接将始终出现在同一个单元格 (AH7) 中。
图像保存在“C:\Fake Folder\Fake SubFolder\image.png”中。如果它更容易/将始终显示,我可以在线上传图像。

我可以找到零碎的信息,但没有任何东西可以一起工作。

Sub Mail_workbook_Outlook_1()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim xStrBody As String
    xStrBody = "Hi" & ThisWorkbook.Sheets("Sheet1").Range("A1") _
      & "Please Click" & "<a href=" & ThisWorkbook.Sheets(Sheet1).Range(AH7) ">C:\Fake Folder\Fake SubFolder\image.png" "Thank you" & "<br>" _
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    With OutMail
        .To = ThisWorkbook.Sheets("Sheet1").Range(J1)
        .Subject = "Test Email"
        .HTMLBody = .HTLMBody & xStrBody
        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

标签: vbaoutlook

解决方案


您需要以正确的方式使用html

Function FileNameFromPath(strFullPath As String) As String    
    FileNameFromPath = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "\"))     
End Function

Sub Mail_workbook_Outlook_test()

Dim OutApp As Object
Dim OutMail As Object
Dim imageFile As String
imageFile = "C:\Fake Folder\Fake SubFolder\image.png"

Dim fileName As String
fileName = FileNameFromPath(imageFile)

Dim xStrBody As Variant
    xStrBody = "<html><p>Hi " & ThisWorkbook.Sheets("Sheet1").Range("A1").Value _
          & "Please Click </p>" & "<a href=" & ThisWorkbook.Sheets("Sheet1").Range("AH7").Hyperlinks(1).Address _
          & "<img src=""" & fileName & """ height=520 width=750></a>" _
          & "<p>Thank you" & "<br></p>"

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

On Error Resume Next
With OutMail
    .to = ThisWorkbook.Sheets("Sheet1").Range("J1").Value
    .Subject = "Test Email"
    .attachments.Add imageFile, 1, 0
    .htmlBody = xStrBody
    .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

如果您在单元格 AH7 中直接有超链接地址,则需要使用.value而不是.Hyperlinks(1).Addressfor ThisWorkbook.Sheets("Sheet1").Range("AH7").Hyperlinks(1).Address。我还假设您多次没有在原始帖子的代码中添加引号。


推荐阅读