发件人是群组电子邮件时出现 Outlook VBA 错误

Question

我有以下信息来识别发件人电子邮件地址和姓名（然后我将其存储以备后用）：

strSender = itm.Sender.GetExchangeUser().PrimarySmtpAddress
strSenderName = itm.Sender

这工作正常，但是当使用组电子邮件地址时（即多个用户可以发送电子邮件的地址，例如 customerservice@company.com），我收到如下错误消息：

运行时错误“91”：
对象变量或未设置块变量

知道如何解决这个问题吗？

完整脚本：

Public Sub saveAcct(itm As Outlook.MailItem)
Const Filepath1 = "C:\Users\tenba1\Documents\QlikView\Account Recons\Recon_Acct.txt"
Const Filepath2 = "C:\Users\tenba1\Documents\QlikView\Account Recons\Recon_Acct_Sender.txt"
Const Filepath3 = "C:\Users\tenba1\Documents\QlikView\Account Recons\Recon_Acct_SenderName.txt"
Const ForWriting = 2

strAccNumber = Trim(Mid(itm.Subject, InStrRev(itm.Subject, " "), Len(itm.Subject) - InStr(1, itm.Subject, " ")))
strSender = itm.Sender.GetExchangeUser().PrimarySmtpAddress
strSenderName = itm.Sender


Do Until FileExists("C:\Users\tenba1\Documents\QlikView\Account Recons\DONE.txt")
Loop

'Create a Busy file:
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("C:\Users\tenba1\Documents\QlikView\Account Recons\BUSY.txt", True)
MyFile.Close

'Delete the DONE file:
aFile = "C:\Users\tenba1\Documents\QlikView\Account Recons\DONE.txt"
Kill aFile

'Update the Account Number File:
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objFile1 = objFSO1.OpenTextFile(Filepath1, ForWriting)
objFile1.Write ("SET vAcct = '" & strAccNumber & "';")

'Update the Sender Email Address File:
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objFile2 = objFSO2.OpenTextFile(Filepath2, ForWriting)
objFile2.Write (strSender)

'Update the Sender Name File:
Set objFSO3 = CreateObject("Scripting.FileSystemObject")
Set objFile3 = objFSO3.OpenTextFile(Filepath3, ForWriting)
objFile3.Write (strSenderName)

'Launch the PowerShell Script for creating the recon file:
Dim shell
Set shell = CreateObject("wscript.shell")
shell.Run "C:\Users\tenba1\Documents\Scripts\Account_Recon.bat"

End Sub

Answer 1

您永远不会检查GetExchangeUser()返回有效对象。 对于一次性 SMTP 对象，它将返回 null。

更新：尝试类似以下内容：

strSender = ""
strSenderName  = itm.SenderName
If itm.SenderEmailAddress = "EX" Then
  set objSender = itm.Sender
  If Not (objSender Is Nothing) Then
    set objExchUser = Sender.GetExchangeUser()
    If Not (objExchUser Is Nothing) Then
      strSender = objExchUser.PrimarySmtpAddress
    End If
  End If
Else
  strSender = itm.SenderEmailAddress
End If

Answer 2

德米特里回应的关键部分是：

set objExchUser = Sender.GetExchangeUser()
If Not (objExchUser Is Nothing) Then <do something>

对发件人的检查是初步的，解决了与@user2725402 提出的问题不同的问题。

正如 Dmitry 在他的第一句话中所暗示的，群组电子邮件的问题在于缺少有效的 Exchange 用户。 有关 GetExchangeUser 方法的Microsoft 文档指出，“如果 AddressEntry 对象与 Exchange 用户不对应，则返回 Null（在 Visual Basic 中为空）”。 所以这是您要检查组电子邮件地址是否为空值的地方。

概括：
要解决此类问题，请检查有效的 Exchange 用户，并且仅在您知道存在的情况下才继续：

    If Msg.SenderEmailType = "EX" Then 'email is from within your Exchange
        Dim objExchangeUser As Object
        Set objExchangeUser = Msg.Sender.GetExchangeUser()
        If objExchangeUser Is Nothing Then Exit Sub <or other appropriate action>
    End If