VBA宏设置SendUsingAccount仍无法用指定Outlook账号发邮件，怎么解决？

核心问题排查 #

你的代码里有两个关键问题导致SendUsingAccount不生效：

1. 语法错误：匹配账号时，邮箱地址example@company.com未加双引号，VBA会将其识别为未定义变量，根本无法匹配到目标账号
2. 匹配逻辑不准确：用DisplayName（账户显示名称）匹配账号不可靠，显示名称可能是中文昵称或别名，应该用唯一的SmtpAddress（邮箱地址）来匹配

修正后的代码 #

Sub Mails()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Table1") 
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    Dim outlookApp As Object
    Dim mailItem As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Dim i As Long

    Dim otherAccount As Object
    ' 修正：用SmtpAddress匹配，并且邮箱地址加双引号
    For Each acc In outlookApp.Session.Accounts
        If acc.SmtpAddress = "example@company.com" Then 
            Set otherAccount = acc
            Exit For
        End If
    Next acc

    ' 新增：如果找不到账号，弹出提示后退出
    If otherAccount Is Nothing Then
        MsgBox "未找到目标邮箱账号，请检查Outlook配置或邮箱地址是否正确"
        Exit Sub
    End If

    For i = 1 To lastRow
        If IsDate(ws.Cells(i, "E").Value) Then
            Set mailItem = outlookApp.CreateItem(0)
            With mailItem
                .SendUsingAccount = otherAccount
                .To = ws.Cells(i, "F").Value
                ' .CC = ' optional
                .Subject = "Reminder" & ws.Cells(i, "A").Value
                .HTMLBody = ""

                .Send
            End With
        End If
    Next i

    Set mailItem = Nothing
    Set outlookApp = Nothing
    Set otherAccount = Nothing
End Sub

额外验证步骤 #

如果还是无法生效，可以尝试以下操作：

• 打开Outlook，确认目标账号已正常配置并能收发邮件
• 运行代码前关闭Outlook的所有弹窗（如未读邮件提示、同步提示等）
• 可以在设置SendUsingAccount后添加调试语句，确认账号是否正确赋值：

  Debug.Print "使用账号：" & otherAccount.SmtpAddress
  

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