如何使用VBA指定Outlook账户发送邮件

要指定特定的Outlook账户（如abc@abc.com）发送邮件，你需要遍历Outlook的账户集合，找到匹配的账户后，将邮件的SendUsingAccount属性设置为该账户。以下是修改后的完整代码：

Sub SendEmail()
    Dim i As Integer
    Dim lr As Long
    Dim outlookApp As Object
    Dim mailItem As Object
    Dim targetAccount As Object
    
    ' 获取数据最后一行
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 创建Outlook应用对象
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' 遍历账户，找到目标账户abc@abc.com
    For Each targetAccount In outlookApp.Session.Accounts
        If targetAccount.SmtpAddress = "abc@abc.com" Then
            Exit For
        End If
    Next targetAccount
    
    ' 检查是否找到目标账户
    If targetAccount Is Nothing Then
        MsgBox "未找到指定的Outlook账户：abc@abc.com", vbExclamation
        Set outlookApp = Nothing
        Exit Sub
    End If
    
    ' 逐行发送邮件
    For i = 2 To lr
        Set mailItem = outlookApp.CreateItem(0) ' 0对应olMailItem常量值
        With mailItem
            .SendUsingAccount = targetAccount ' 指定发送账户
            .Subject = Range("B" & i).Value
            .To = Range("A" & i).Value
            .Body = Range("C" & i).Value
            '.CC = Range("G" & i).Value
            '.Send ' 取消注释即可自动发送邮件
            .Display ' 临时显示邮件，用于测试
        End With
        Set mailItem = Nothing
    Next i
    
    MsgBox "邮件操作完成", vbInformation
    Set outlookApp = Nothing
    Set targetAccount = Nothing
End Sub

关键修改说明： #

• 账户匹配逻辑：通过outlookApp.Session.Accounts遍历所有Outlook配置账户，根据SmtpAddress精准定位目标账户。
• 指定发送账户：给每个邮件实例的SendUsingAccount属性赋值，确保邮件从指定地址发出。
• 变量优化：替换原代码中未赋值的o变量，直接使用0（对应Outlook的olMailItem常量数值，后期绑定无需额外引用库）；明确变量类型，提升代码可读性。
• 错误防护：增加未找到目标账户的提示，避免后续代码执行出错。

使用提示： #

1. 确保Outlook已启动，且abc@abc.com账户已在Outlook中完成配置。
2. 若需自动发送邮件，取消.Send的注释并注释掉.Display即可。

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