Outlook中基于附件名切换发件邮箱的Application_ItemSend事件异常

你的代码里用SentOnBehalfOfName切换发件邮箱是核心问题——这个属性用于代理发送（需要目标邮箱给你授权），而非切换你自己名下的次要邮箱。要实现用自己的次要邮箱发送，必须使用SendUsingAccount属性，指定Outlook中已配置的对应账户。

修改后的VBA代码 #

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim mailItem As Outlook.MailItem
    Dim attachment As Outlook.Attachment
    Dim targetSmtp As String
    Dim sendAccount As Outlook.Account
    
    ' 只处理邮件项
    If TypeName(Item) <> "MailItem" Then Exit Sub
    Set mailItem = Item
    targetSmtp = "new_sender_email" ' 替换成你的次要邮箱SMTP地址
    
    ' 遍历附件，检查是否包含指定关键词
    For Each attachment In mailItem.Attachments
        If InStr(LCase(attachment.FileName), "rechnung") > 0 Then
            ' 遍历Outlook账户，找到匹配的次要邮箱账户
            For Each sendAccount In Outlook.Application.Session.Accounts
                If LCase(sendAccount.SmtpAddress) = LCase(targetSmtp) Then
                    Set mailItem.SendUsingAccount = sendAccount
                    Exit For
                End If
            Next sendAccount
            
            ' 验证是否找到目标账户
            If mailItem.SendUsingAccount Is Nothing Then
                MsgBox "未找到指定的次要邮箱账户，请检查配置", vbExclamation
                Cancel = True
            End If
            
            Exit For ' 找到符合条件的附件后退出循环
        End If
    Next attachment
End Sub

关键说明 #

• SendUsingAccount的作用：直接指定Outlook中已配置的账户作为发件人，这是切换自己名下多个邮箱的正确方式。
• 账户匹配逻辑：通过遍历Session.Accounts集合，对比SMTP地址找到目标账户，避免名称匹配的误差。
• 调试注意事项：
  • 确保你的次要邮箱已经在Outlook的账户设置中添加并配置完成。
  • 代码必须放在ThisOutlookSession模块中，保存后重启Outlook并启用宏。
  • 若仍有问题，可在代码中添加Stop语句逐步调试，确认是否找到目标账户。

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