使用新Outlook的VBA邮件发送失败问题求助

阿华AIGC实验室

2026-6-15

解决Outlook VBA邮件发送失败问题

你的邮件能正常显示但无法发送、保存草稿后发送报错，核心原因是HTML正文的链接引号格式错误，破坏了邮件的HTML结构，导致Outlook拒绝处理损坏的邮件。以下是具体修复方案：

问题定位

代码中拼接SharePoint链接时，使用了""""来包裹URL，这会导致HTML的href属性语法错误（例如<a href=""https://xxx"">），这种格式不符合HTML规范，Outlook能勉强渲染但无法完成发送或草稿发送操作。

修复步骤

修正HTML链接的引号格式
在VBA中拼接HTML属性时，使用Chr(34)（代表双引号）或"（HTML转义双引号）来包裹URL，确保每个href的引号成对且格式正确。
优化邮件对象的Display调用
代码中重复调用.Display会干扰邮件状态，保留一次即可（如果你的GetSignature函数需要依赖已显示的邮件来获取签名）。
强制变量声明
在模块顶部添加Option Explicit，避免未声明变量引发的潜在问题（原代码中username、currentDate等变量未声明）。

修复后的完整代码

Option Explicit

Sub EmailforVids()
    Dim ccPeeps As String, VidEmailSubject As String, VidEmailLink As String
    Dim EmailApp2 As Object, EmailItem2 As Object
    Dim Signature As String, xMailBody As String
    Dim username As String, currentDate As String
    
    ccPeeps = ""
    VidEmailForm.Show ' 从用户窗体获取变量
    
    Set EmailApp2 = CreateObject("Outlook.application")
    Set EmailItem2 = EmailApp2.CreateItem(0)
    
    ' 仅调用一次Display以获取签名（若GetSignature依赖此操作）
    With EmailItem2
        .Display
    End With
    
    username = Environ$("USERNAME")
    Signature = GetSignature("DART")
    currentDate = Format(Now, "yyyymmdd")
    
    ' 设置问候语
    If Time < TimeValue("12:00:00") Then
        xMailBody = "Good Morning"
    ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
        xMailBody = "Good Afternoon"
    Else
        xMailBody = "Good Evening"
    End If
    
    With EmailItem2
        .To = "(redacted)"
        .cc = ccPeeps
        .Subject = VidEmailSubject
        ' 使用Chr(34)生成标准双引号，确保HTML格式正确
        .HTMLbody = "<BODY style=font-size:12pt;font-family:Aptos>" & xMailBody & ",<br><br>" & _
                    "<a href=" & Chr(34) & VidEmailLink & Chr(34) & ">" & VidEmailSubject & "</a><br><br>" & _
                    "Attached Review Players if needed for .cva files:<br>" & _
                    "<a href=" & Chr(34) & "https://redacted.sharepoint.com/:u:/s/tccapps/EbkNE4bZpbJFp2TLvs4cI7cBm1FqQ8WhiuR5191aGXydYA?e=mrKvYs" & Chr(34) & ">x64 Player</a><br>" & _
                    "<a href=" & Chr(34) & "https://redacted.sharepoint.com/:u:/s/tccapps/EUKwdQSAtkJDv7tAMn1jvcgB891TeE74yiUfRM4exVReRw?e=wplpxf" & Chr(34) & ">win32 Player</a><br><br>" & _
                    Signature
        .Send
    End With
    
    Set EmailItem2 = Nothing
    Set EmailApp2 = Nothing
End Sub