试图覆盖新电子邮件中的发件人地址

Question

请懂VBA代码的人帮帮我？

Run-time error '91': Object variable or With block variable not set

我正在尝试覆盖新电子邮件中的发件人地址，但某些帐户除外。 oMail.SentOnBehalfOfName = "<redacted>@<redacted>.com" 行处理了这个问题，但有些帐户我不希望这样做，因此其余的。宏正常工作，但如果我打开电子邮件模板，我会收到上述错误，并且调试器会突出显示 If 语句的第一行。

Public Sub SetFromAddress(oMail As Outlook.MailItem)
oMail.SentOnBehalfOfName = "<redacted>@<redacted>.com"
' Undo FromAddress overide for other accounts
If InStr(1, oMail.SendUsingAccount, "<redacted>@<redacted>.com", vbTextCompare) > 0 Then
    oMail.SentOnBehalfOfName = "<redacted>@<redacted>.com"
End If
End Sub

完整代码：

Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer

Private Sub Application_Startup()
   Initialize_handler
End Sub

Public Sub Initialize_handler()
   Set objInspectors = Application.Inspectors
   Set myOlExp = Application.ActiveExplorer
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
   If Inspector.CurrentItem.Class = olMail Then
       Set objMailItem = Inspector.CurrentItem
       If objMailItem.Sent = False Then
           Call SetFromAddress(objMailItem)
       End If
   End If
End Sub

'Uncomment the next 3 lines to enable Outlook 2013/2016/2019/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
   Call SetFromAddress(objItem)
End Sub

Public Sub SetFromAddress(oMail As Outlook.MailItem)
' Set your preferred default From address below.
' Exchange permissions determine if it is actually stamped
' as "Sent On Behalf Of" or "Sent As".
' The address is not properly updated for the InlineResponse
' feature in Outlook 2013/2016/365. This is only a visual bug.
oMail.SentOnBehalfOfName = "aaa@domain.com"

' Undo FromAddress overide for other accounts
   If InStr(1, oMail.SendUsingAccount, "bbb@domain.com", vbTextCompare) > 0 Then
    oMail.SentOnBehalfOfName = "bbb@domain.com"
   End If
End Sub

Answer 1

无需为新项目设置这两个属性 - SentOnBehalfOfName and SendUsingAccount。相反，您需要根据需要选择一个。

SendUsingAccount 属性设置或获取一个 Account 对象，该对象代表要发送 MailItem 的帐户。这意味着其他帐户应该在 Outlook 中配置。

SentOnBehalfOfName 属性设置一个字符串，指示邮件消息的预期发件人的显示名称。在那种情况下，您需要确保您有足够的权限代表另一个人发送。

但是下面的错误信息清楚地表明您没有处理有效的邮件项目：

Run-time error '91': Object variable or With block variable not set

您可以检查传递给该方法的参数。请记住，Outlook 文件夹可能包含不同种类的项目。有时检查消息 class 以确保您处理的是邮件。

Answer 2

行

If InStr(1, oMail.SendUsingAccount, "<redacted>@<redacted>.com", vbTextCompare) > 0 Then

假定 oMail.SendUsingAccount 已设置。检查以确保它不为空（请注意 If 语句被分成两部分，因为 VB 脚本没有 short-circuit 布尔语句）

if Not oMail.SendUsingAccount Is Nothing Then
  If InStr(1, oMail.SendUsingAccount.DisplayName, "<redacted>@<redacted>.com", vbTextCompare) > 0 Then

Answer 3

对于发现此完整且显然有效的脚本的任何人：

'================================================================================
'Description: Outlook macro to automatically set a different
'             From address.
'
'Comment: You can set the email address at the bottom of the code.
'         Uncomment the myOlExp_InlineResponse sub to also make it
'         work with the Reading Pane reply feature of Outlook 2013/2016/2019/365.
'
' author : Robert Sparnaaij (updated to include templates)
' version: 1.1 (1.2)
' website: https://www.howto-outlook.com/howto/setfromaddress.htm
'================================================================================

Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer

Private Sub Application_Startup()
    Initialize_handler
End Sub

Public Sub Initialize_handler()
    Set objInspectors = Application.Inspectors
    Set myOlExp = Application.ActiveExplorer
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail Then
        Set objMailItem = Inspector.CurrentItem
        If objMailItem.Sent = False Then
            Call SetFromAddress(objMailItem)
        End If
    End If
End Sub

' Enable Outlook 2013/2016/2019/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
    Call SetFromAddress(objMailItem)
End Sub

Public Sub SetFromAddress(oMail As Outlook.MailItem)
    ' Set your preferred default From address below.
    ' Exchange permissions determine if it is actually stamped as "Sent On                 Behalf Of" or "Sent As".
    ' The address is not properly updated for the InlineResponse feature in Outlook 2013/2016/365. This is only a visual bug.
    If Not oMail.SendUsingAccount Is Nothing Then
        If oMail.SendUsingAccount.DisplayName = "default-address@domain" Then ' Default send address to be replaced.
            oMail.SentOnBehalfOfName = "desired-address@domain" ' Desired send address (must have delegate permission or be an alias).
        End If
    End If
End Sub

试图覆盖新电子邮件中的发件人地址

trying to override the from address in new emails

outlook

vba