Outlook VBA中MailItem.SendUsingAccount偶发返回Nothing问题咨询

SendUsingAccount偶尔返回空值有三类常见触发场景：

• 回复/转发共享邮箱、公共文件夹内的邮件时，Outlook不会主动为邮件对象绑定发送账号，该属性默认返回Nothing，系统会自动使用当前默认账号发送，直到发送完成属性才会被回填，ItemSend触发时点还未完成赋值
• 第三方程序调用Outlook接口自动发信时，若未显式指定SendUsingAccount属性，该属性也会返回空
• Exchange缓存模式开启时，新创建的邮件对象属性同步存在延迟，ItemSend触发时该属性还未加载完成，会返回Null

*补充说明Null和Nothing的差异：VBA中Nothing是对象类型的空引用，Null是变体类型的空值。你当前代码直接将Account类型的SendUsingAccount赋值给字符串变量ZendAcc，当属性为空时会触发类型不匹配错误，而非返回空字符串，这是故障的直接诱因。

你需要先做对象非空判断，再取账号的SMTP地址属性，同时加兜底逻辑适配属性为空的场景，修正后的代码如下：

Public WithEvents myOlItems As Outlook.Items

'点击Outlook邮件发送按钮时触发的子程序
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim ZendAcc As String
    Dim sendAcc As Account
    '校验是否存在多账号
    If Application.Session.Accounts.Count > 1 Then
        '校验对象是否为MailItem类型（通常均符合要求）
        If TypeName(Item) <> "MailItem" Then
            MsgBox "不存在MailItem对象"
            Exit Sub
        Else
            '先判断发送账号是否为空
            Set sendAcc = Item.SendUsingAccount
            If Not sendAcc Is Nothing Then
                ZendAcc = sendAcc.SmtpAddress
            Else
                '兜底逻辑1：通用场景取当前默认账号的SMTP地址
                ZendAcc = Application.Session.Accounts.Item(1).SmtpAddress
                '兜底逻辑2：适配共享邮箱代发场景可替换为以下代码
                'If Item.SendOnBehalfOfName <> "" Then
                '    ZendAcc = Item.SendOnBehalfOfName
                'Else
                '    ZendAcc = Application.Session.Accounts.Item(1).SmtpAddress
                'End If
            End If
            If ZendAcc = "" Then
                Exit Sub
            End If
            '创建监听器并传入账号名字符串
            Call Initialize_handler(ZendAcc)
        End If
    Else
        '仅存在单账号时账号名无实际意义，仅需传入字符串参数
        Call Initialize_handler("Useless")
    End If
End Sub

Public Sub Initialize_handler(ByVal zendAccount As String)
    Dim Store As Store
    Dim acFolder As Folder
    Dim oAccount As Account
    '多账号场景下匹配对应已发送邮件文件夹，单账号场景使用默认文件夹
    If Application.Session.Accounts.Count > 1 Then
        For Each oAccount In Application.Session.Accounts
            If oAccount.SmtpAddress = zendAccount Then
                Set Store = oAccount.DeliveryStore
                Set acFolder = Store.GetDefaultFolder(olFolderSentMail)
                Exit For
            End If
        Next
        '兜底：如果没找到对应账号的文件夹，用默认已发送文件夹
        If acFolder Is Nothing Then
            Set acFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
        End If
        Set myOlItems = acFolder.Items
    Else
        Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
    End If
End Sub

'捕获新增的已发送邮件并保存到指定文件夹
Private Sub myOlItems_ItemAdd(ByVal ObjectSent As Object)
    '此处为邮件处理逻辑，本例中为保存到指定文件夹
End Sub

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