Excel VBA中Outlook自动发邮件.SentOnBehalfOfName失效求助

我用Excel VBA开发Outlook自动发邮件程序，之前.SentOnBehalfOfName属性正常工作，但现在新旧程序里该属性都失效。我拥有目标邮箱的发送权限，手动可以从该邮箱发邮件，程序能正常生成邮件，但发件人始终显示我的个人工作邮箱，必须手动修改。相关VBA代码如下：

Sub Make_Email(Wood As Variant, metal As Variant, SendID As Variant)
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim i As Integer
    Dim NewSubject As Variant
    Dim InvoiceCount As Integer
    Dim PartnerName As Variant
    Dim Folder As Variant
    Dim EmailLR As Variant
    Dim EmailArray As Variant
    Dim mainWB As Workbook
    Dim CCID
    Dim Subject
    Dim Body
    Dim olMail As MailItem
    Set otlApp = CreateObject("Outlook.Application")
    Set olMail = otlApp.CreateItem(olMailItem)
    Set Doc = olMail.GetInspector.WordEditor

    Dim Link As Variant
    Dim EmailBody As Variant

    EmailBody = "text of email is here"

    Subject = "Subject text is here"
    With olMail
        .SentOnBehalfOfName = "email.this.should.be.from@mycompany.com" 'this is the part that is not working
        .To = SendID
        .Subject = Subject
        .HTMLBody = EmailBody
        .Display
        '.Send
    End With
    
End Sub

解决方法 #

1. 替换为SendUsingAccount属性（推荐） #

SentOnBehalfOfName依赖Exchange服务器权限配置，容易受缓存或权限变动影响，改用指定发送账户的方式更可靠：

Sub Make_Email(Wood As Variant, metal As Variant, SendID As Variant)
    Option Explicit ' 强制变量声明，避免隐式错误
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim i As Integer
    Dim NewSubject As Variant
    Dim InvoiceCount As Integer
    Dim PartnerName As Variant
    Dim Folder As Variant
    Dim EmailLR As Variant
    Dim EmailArray As Variant
    Dim mainWB As Workbook
    Dim CCID
    Dim Subject
    Dim Body
    Dim olMail As MailItem
    Dim otlApp As Outlook.Application
    Dim sendAccount As Outlook.Account
    
    Set otlApp = CreateObject("Outlook.Application")
    Set olMail = otlApp.CreateItem(olMailItem)
    
    ' 遍历账户找到目标邮箱
    For Each sendAccount In otlApp.Session.Accounts
        If sendAccount.SmtpAddress = "email.this.should.be.from@mycompany.com" Then
            Set olMail.SendUsingAccount = sendAccount
            Exit For
        End If
    Next sendAccount

    Dim Link As Variant
    Dim EmailBody As Variant

    EmailBody = "text of email is here"
    Subject = "Subject text is here"
    
    With olMail
        .To = SendID
        .Subject = Subject
        .HTMLBody = EmailBody
        .Display
        '.Send
    End With
    
    ' 释放对象
    Set olMail = Nothing
    Set otlApp = Nothing
End Sub

说明：该方法直接调用Outlook中已配置的目标账户，绕过代理发送的权限依赖，前提是目标邮箱已添加到你的Outlook账户列表。

2. 验证Exchange服务器权限 #

即使手动能发，也可能是服务器端权限配置变更：

• 联系IT管理员确认你的账户是否仍拥有目标邮箱的代表发送（Send On Behalf Of）权限，若权限被改为代理发送（Send As），SentOnBehalfOfName会失效
• 若需要保留原属性，可要求管理员恢复「代表发送」权限

3. 清理Outlook缓存 #

缓存文件异常可能导致权限识别错误：

• 关闭Outlook，前往C:\Users\[你的用户名]\AppData\Local\Microsoft\Outlook
• 备份后删除.ost或.pst缓存文件
• 重启Outlook，重新同步服务器配置

4. 修复代码变量声明问题 #

原代码中otlApp未显式声明类型，可能引发隐式调用错误：

• 在代码开头添加Option Explicit，强制所有变量必须声明
• 显式声明otlApp为Outlook.Application类型，确保属性调用的准确性

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