如何在Outlook邮件正文添加mailto链接？VB代码编译错误解决

我需要通过Outlook发送邮件，希望在邮件正文里添加可点击的邮箱链接——点击后直接打开新邮件窗口（例如显示文本“ABC mailbox”，对应邮箱地址ABC@gmail.com）。查资料得知正确的HTML语法是 <a href="mailto:ABC@gmail.com">ABC</a>，于是我在VBA代码的HTMLBody中替换了内容，写的代码如下：

.HTMLBody = "\<HTML\>\<BODY\>\<a href="mailto:ABC@gmail.com"\>ABC mailbox\<\/a\>\<\/BODY\>\<\/HTML\>"

但运行代码时触发编译错误，调试时mailto部分被高亮，确定问题出在这部分语法上。附上完整VBA代码：

Sub SendEmailformattext()
'Update by Extendoffice.com
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim OutlookApp As Object
Dim MItem As Object
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set OutlookApp = CreateObject("Outlook.Application")
Set MItem = OutlookApp.CreateItem(olMailItem)
Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each xRgEach In xRg
    xRgVal = xRgEach.Value
    If xRgVal Like "?*@?*.?\*" Then
        Set MItem = xOutApp.CreateItem(olMailItem)
        With MItem
            .Display
            .To = xRgVal
            .Subject = "Test"
            .HTMLBody = "\<HTML\>\<BODY\>\<a href="mailto:ABC@gmail.com"\>ABC mailbox\<\/a\>\<\/BODY\>\<\/HTML\>"
            '.Send
        End With
    End If
Next
Set xMailOut = Nothing

UNCLASSIFIED

Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub

编译错误的核心原因是字符串内部双引号未正确转义，同时你错误地给HTML标签添加了不必要的反斜杠转义。在VB/VBA中，字符串内部的双引号需要用两个双引号("")来转义，HTML标签无需额外加反斜杠。

修正后的关键代码行 #

.HTMLBody = "<HTML><BODY><a href=""mailto:ABC@gmail.com"">ABC mailbox</a></BODY></HTML>"

完整修正代码（含其他小问题修复） #

代码中还存在变量名不一致、无效代码行、邮箱格式判断错误等问题，一并修正后：

Sub SendEmailformattext()
'Update by Extendoffice.com
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim OutlookApp As Object
Dim MItem As Object
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("请选择邮箱地址范围", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set OutlookApp = CreateObject("Outlook.Application")
Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each xRgEach In xRg
    xRgVal = xRgEach.Value
    '修正邮箱格式判断的Like表达式
    If xRgVal Like "?*@?*.?*" Then
        '统一使用已定义的OutlookApp变量
        Set MItem = OutlookApp.CreateItem(olMailItem)
        With MItem
            .Display
            .To = xRgVal
            .Subject = "Test"
            '修正HTMLBody的字符串转义和格式
            .HTMLBody = "<HTML><BODY><a href=""mailto:ABC@gmail.com"">ABC mailbox</a></BODY></HTML>"
            '.Send
        End With
    End If
Next
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub

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