Auto changing the Email .SentOnBehalfOfName doesnt change the from section

[gruntingmonkey]

I am trying to change the send from address when creating an email through VBA but can't seem to manage it. I have added " .SentOnBehalfOfName = "Test@Test.com"" but it doesnt change it in the email that it pops up.

Sub SendFileTESTVERSION()

 On Error GoTo ErrHandler
    '''creates the email with details

    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    
    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)
    
    Datestamp = Format(Date, "mmm yyyy")
    strbody = "Hello all," & _
              "<br><br>Please find attached the Dashboard for " & Datestamp & "." & _
              "<br><br>Kind regards,"
              
    EmailTo = Worksheets("Utilities").Cells(14, 4).Value
    Filept = "C:\Test\"
    FileNm = "Dashboard.xlsx"
    attfile1 = Filept + FileNm

'''Create email
    On Error Resume Next
    With objEmail
        .Display
        .SentOnBehalfOfName = "Test@Test.com"
        .To = EmailTo
        .Subject = "Dashboard for " & Datestamp & ""
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .attachments.Add attfile1
        '.send
        .Display
    End With
    
     Set objEmail = Nothing:    Set objOutlook = Nothing
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

Sheets("Utilities").Activate

Sheets("Utilities").Select
Cells(13, 3).Value = "Complete"

Exit Sub

ErrHandler:
MsgBox "There has been an error"
End Sub

 

[rollis13]

Works for me. Try without using the line On Error Resume Next while testing and see if your macro throws an error for that parameter.

 

[NotEnoughCaffiene]

This is I think a bug with the VBA model. I have found that you can't display the email (.display) and then change the send on behalf of (.SentOnBehalfOfName). Simply re-order your code, and it should work.

With objEmail
        [B].SentOnBehalfOfName = "Test@Test.com"[/B]
        .To = EmailTo
        .Subject = "Dashboard for " & Datestamp & ""
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .attachments.Add attfile1
        '.send
        [B].Display[/B]
    End With