Sending Outlook Msg via VBA, but having the 2nd Outlook account in the from.

[countryfan_nt]

Hello friends, Hope all is well! Please help adjust the code.

I have two outlook accounts, one for me, the other is for the MIS Dept. I wish to send outlook msgs, using the second account please.
The code below keeps only sending mail with my name. the other outlook address is secondary.

Your kind help is really appreciated!

Sub SENDMAIL()
    'Add reference to Microsoft Outlook Object Library
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim OutAccount As Outlook.Account
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    'Use the first account, see that Item is 1 now
   ' Set OutAccount = OutApp.Session.Accounts.Item(2)
    
    'Or us the name instead of the number
    Set OutAccount = OutApp.Session.Accounts("mis@drs.com")
   
ToAddress = Sheets("DB").Range("f1").Value

    'Create New Outlook Email Item to Attach Image(s)
   On Error Resume Next
    With OutMail
        .To = ToAddress
        .CC = ""
        .BCC = ""
        .Subject = "Thank you"
        .BodyFormat = olFormatHTML
           
        .Attachments.Add "C:\Users\nawaf.altaher\Downloads\avs\ssare\" & Worksheets("db").Range("E1").Value & ".png", olByValue, 0
        .HTMLBody = "<img src=""cid:" & Worksheets("db").Range("E1").Value & ".png""  width=""750"" height=""520"">"
                    
       .Display
        '.Send 'or just put .Display to check
    End With

    Set OutlookMail = Nothing
    Set OutApp = Nothing
End Sub

 

[daverunt]

look up SentOnBehalfOf

 

[FuNeS13]

Sub SENDMAIL()
    'Add reference to Microsoft Outlook Object Library
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim OutAccount As Outlook.Account
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
   
    'Use the first account, see that Item is 1 now
   ' Set OutAccount = OutApp.Session.Accounts.Item(2)
   
    'Or us the name instead of the number
    Set OutAccount = OutApp.Session.Accounts("mis@drs.com")
  
ToAddress = Sheets("DB").Range("f1").Value

    'Create New Outlook Email Item to Attach Image(s)
   On Error Resume Next
    With OutMail
        .SentOnBehalfOfName = "secondemail@mrexcelcom"
        .To = ToAddress
        .CC = ""
        .BCC = ""
        .Subject = "Thank you"
        .BodyFormat = olFormatHTML
          
        .Attachments.Add "C:\Users\nawaf.altaher\Downloads\avs\ssare\" & Worksheets("db").Range("E1").Value & ".png", olByValue, 0
        .HTMLBody = "<img src=""cid:" & Worksheets("db").Range("E1").Value & ".png""  width=""750"" height=""520"">"
                   
       .Display
        '.Send 'or just put .Display to check
    End With

    Set OutlookMail = Nothing
    Set OutApp = Nothing
End Sub

 

[daverunt]

SentOnBehalfOfName - Sorry.