如何在Excel邮件发送宏中为不同收件人添加专属超链接

要实现每封邮件正文带专属超链接，核心是把Outlook邮件的正文格式从纯文本改成HTML（纯文本不支持超链接），然后将对应行的超链接地址嵌入到HTML内容里。

修改后的VBA代码 #

假设你的超链接地址存放在U列（对应每一行的收件人），可按下面的代码修改：

Sub Button1_Click()
    Dim rngCell As Range
    Dim Rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strHTMLBody As String
    Dim EmailSubject As String
    Dim SendToMail As String
    Dim r As Long
    Dim hyperlinkAddr As String ' 存储当前行的超链接地址
    
    Application.ScreenUpdating = False
    With ActiveSheet
        If .FilterMode Then .ShowAllData
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set Rng = Range("T5", Cells(Rows.Count, "T").End(xlUp))
    
    For Each rngCell In Rng
        r = rngCell.Row
        If Range("J" & r).Value = "" And Range("K" & r).Value <> "" And Range("I" & r).Value <= Date Then
            Range("J" & r).Value = Date
            Set OutMail = OutApp.CreateItem(0)
            
            ' 获取当前行的超链接地址（可根据实际列调整）
            hyperlinkAddr = Range("U" & r).Value
            
            ' 构建HTML格式的邮件正文，插入专属超链接
            strHTMLBody = "<p>根据记录，你的 " & Range("A" & r) & Range("S" & r).Value & _
                " 合同已到复核时间，该合同将于 " & Range("K" & r).Value & _
                " 到期。请尽快复核合同并邮件告知所有修改内容。</p>" & _
                "<p>如果合同续签或延期，请填写<a href='" & hyperlinkAddr & "'>合同封面表</a>，" & _
                "该表格可在Everyone文件夹中获取，填写完成后请将封面表及新的原始合同一并发送给我。</p>"
            
            SendToMail = Range("T" & r).Value
            EmailSubject = Range("A" & r).Value
            
            On Error Resume Next
            With OutMail
                .To = SendToMail
                .CC = "隐私原因已移除邮箱地址"
                .BCC = ""
                .Subject = EmailSubject
                .HTMLBody = strHTMLBody ' 使用HTML格式正文
                .Display ' 测试时用.Display，正式发送改成.Send
            End With
            On Error GoTo 0 ' 恢复默认错误处理
            
            Set OutMail = Nothing
        End If
    Next rngCell
    
    Application.ScreenUpdating = True
    Set OutApp = Nothing
End Sub

关键修改说明 #

• 新增hyperlinkAddr变量，用于读取当前行的超链接地址（可根据实际存放超链接的列修改，比如改成Range("V" & r).Value）
• 将原纯文本正文改为HTML格式，用<a href='" & hyperlinkAddr & "'>合同封面表</a>插入专属超链接，href属性对应当前行的超链接地址
• 把.Body = strBody替换成.HTMLBody = strHTMLBody，让Outlook以HTML格式渲染邮件正文
• 添加On Error GoTo 0恢复默认错误处理，避免后续代码忽略异常
• 新增对象释放语句，避免内存占用

注意事项 #

1. 确保存放超链接的列内容是完整的URL地址，例如https://example.com/contract-form.xlsx
2. 可通过调整HTML标签优化正文格式，比如用<br>换行、<strong>加粗文本等
3. 测试阶段保持.Display确认内容正确后，再改成.Send自动发送

内容的提问来源于stack exchange，提问作者Diana Miller