Outlook VBA邮件发送校验代码语法错误排查及功能完善求助

需求：当邮件正文中出现特定词汇时，检查收件人（To/CC字段）是否包含指定邮箱地址，若未包含则弹出确认弹窗询问是否发送。

修改后的代码在语句address = address & recip & & vbCrLf处出现Compile error: Syntax error编译错误，需修复该错误并完善代码功能。

初始代码 #

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim Recipients As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim i
    Dim prompt As String
    Dim iIndex As Long
    
    On Error Resume Next
    
    Checklist = "address@example.com"
    iIndex = InStr(Item.Body, "word")

    Set Recipients = Item.Recipients
    For i = Recipients.Count To 1 Step -1
        Set recip = Recipients.Item(i)
        
        If iIndex > 0 Then
            If Not InStr(LCase(recip), LCase(Checklist)) Then
                prompt$ = "You may have forgotten to send this to address. Are you sure you want to send it?"
                If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
                    Cancel = True
                End If
            End If
        End If
        
    Next i

End Sub

出错的修改后代码 #

Private Sub Application_ItemSend(ByVal Item As Object, ByRef Cancel As Boolean)

    Dim Recipients As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim i
    Dim prompt As String
    Dim iIndex As Long
    Dim addFound As Boolean
    Dim address As String
    addFound = False


    On Error Resume Next

    CheckList = "address@example.com"
    iIndex = InStr(Item.Body, "word")

    Set Recipients = Item.Recipients
    For i = Recipients.Count To 1 Step -1
        Set recip = Recipients.Item(i)

        If InStr(1, LCase(CheckList), LCase(recip)) >= 1 Then
            addFound = True
            address = address & recip & & vbCrLf
            Exit For
        End If

        If iIndex > 0 Then
            If addFound = False Then
                prompt$ = "You may have forgotten to send this to address. Are you sure you want to send it?"
                If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
                    Cancel = True
                End If
            End If
        End If

    Next i


End Sub

1. 编译错误修复 #

出错语句中多了一个冗余的&符号，正确写法应为address = address & recip.Address & vbCrLf。同时直接拼接recip对象会输出对象名称，需改用recip.Address获取实际邮箱地址。

2. 功能完善后的完整代码 #

Private Sub Application_ItemSend(ByVal Item As Object, ByRef Cancel As Boolean)
    Dim Recipients As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim i As Long
    Dim prompt As String
    Dim iIndex As Long
    Dim addFound As Boolean
    Dim addressList As String
    Dim checkEmail As String
    
    addFound = False
    checkEmail = "address@example.com" ' 指定需要检查的目标邮箱
    ' 不区分大小写检查正文是否包含关键词
    iIndex = InStr(LCase(Item.Body), LCase("word"))

    Set Recipients = Item.Recipients
    
    ' 遍历所有收件人，确认是否包含目标邮箱
    For i = Recipients.Count To 1 Step -1
        Set recip = Recipients.Item(i)
        ' 精准匹配邮箱地址（不区分大小写）
        If LCase(recip.Address) = LCase(checkEmail) Then
            addFound = True
            addressList = addressList & recip.Name & " (" & recip.Address & ")" & vbCrLf
            Exit For ' 找到目标邮箱后直接退出循环
        End If
    Next i
    
    ' 仅当正文含关键词且未找到目标邮箱时，弹出确认弹窗
    If iIndex > 0 And Not addFound Then
        prompt = "你可能忘记添加收件人 " & checkEmail & "，确定要发送这封邮件吗？"
        If MsgBox(prompt, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "收件人检查") = vbNo Then
            Cancel = True ' 用户选择不发送，取消邮件发送操作
        End If
    End If
End Sub

代码优化说明 #

• 关键词匹配：用LCase统一转换为小写，实现不区分大小写的模糊匹配。
• 收件人校验：直接比较收件人Address属性，避免名称匹配带来的误差，确保校验精准。
• 弹窗逻辑：遍历完所有收件人后再判断是否弹窗，避免循环中重复触发提示。
• 变量命名：将address改为addressList，避免与VBA内置关键字冲突，提升代码可读性。

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