使用VBA从Outlook非默认账户发送邮件失败问题排查

核心问题1：重复创建Outlook实例 #

你的代码里同时初始化了两个独立的Outlook应用实例：

Set ol = New Outlook.Application ' 实例1
Set OutlookApp = CreateObject("Outlook.Application") ' 实例2

这两个实例的Session和账户列表完全隔离，用实例1的账户对象给实例2创建的邮件赋值，属于跨实例无效操作，直接导致发件人设置失效。

核心问题2：.Display调用时机错误 #

你先调用.Display显示邮件窗口，之后才设置.SendUsingAccount。Outlook在显示邮件后会锁定部分发件人相关的UI状态，后续修改无法同步到已打开的窗口，最终仍用默认账户发送。

其他潜在问题：账户匹配方式不可靠 #

用账户显示名称"Contato"匹配Accounts集合容易出错——如果显示名称有空格、大小写差异，或Outlook内部存储的账户名称与视觉显示不一致，就会匹配失败，改用SMTP地址匹配更稳定。

修正后的代码 #

Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Dim targetAccount As Outlook.Account

' 仅创建一个Outlook实例
Set OutlookApp = New Outlook.Application

' 用SMTP地址精准定位目标账户（替换为你的非默认账户邮箱）
For Each targetAccount In OutlookApp.Session.Accounts
    If targetAccount.SmtpAddress = "你的非默认账户邮箱@xxx.com" Then
        Exit For
    End If
Next targetAccount

' 先设置发件账户，再执行其他操作
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
    .To = lista_envio
    .Subject = assunto_email
    .HTMLBody = mensagem
    .Attachments.Add caminho ' 移除多余括号，避免强制求值问题
    ' 确认找到目标账户后再设置
    If Not targetAccount Is Nothing Then
        .SendUsingAccount = targetAccount
    End If
    .Display ' 如需直接发送可替换为.Send
End With

' 释放对象
Set OutlookMail = Nothing
Set targetAccount = Nothing
Set OutlookApp = Nothing

关于SendOnBehalfOfName的说明 #

该属性生效的前提是：你拥有Exchange服务器授予的代表发送权限，且目标邮箱为Exchange账户。若无权限，即使界面显示发件人正确，实际发送时也会被服务器强制改回默认账户，这是权限限制导致的，与代码无关。

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