Search code examples
vbaoutlook

How to override the from address in new emails?


I'm trying to override the from address in new emails.

The line oMail.SentOnBehalfOfName = "<redacted>@<redacted>.com" takes care of this, but there are some accounts I don't want this for.

The macro works fine normally, but if I open an email template I get

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

The debugger highlights the first line of the If statement.

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

Full Code:

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 = "[email protected]"

' Undo FromAddress overide for other accounts
   If InStr(1, oMail.SendUsingAccount, "[email protected]", vbTextCompare) > 0 Then
    oMail.SentOnBehalfOfName = "[email protected]"
   End If
End Sub

Solution

  • The line

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

    assumes that oMail.SendUsingAccount is set. Check to make sure it is not null (note that the If statement is split into two since VB Script does not short-circuit boolean statements)

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