Sending Emails from specific account in Outlook

[Bering]

Hi All,

I need your help please: I use this code to send emails from my personal Outlook account and it works brilliantly. I now need to amend the code so that I can send the email from a different account:

I only have 3 accounts, it this can help.... I tried to figure it out by myself with no luck so far and it is quite urgent.

I hope you can help me.

Thank you

Sub Send_Email_With_Signature()
 
    Dim objOutApp As Object, objOutMail As Object
    Dim strBody As String, strSig As String
    Dim strLocation, strFileName, strFileExt, pass As String

    
    Set objOutApp = CreateObject("Outlook.Application")
    Set objOutMail = objOutApp.CreateItem(0)
    
    On Error Resume Next
    
    With objOutMail
    
    
        'SET THE EMAIL CONDITIONS
        .To = ActiveSheet.Range("MailDestinataries")
        .CC = ActiveSheet.Range("CCMailDestinataries")
        .BCC = ""
        .Subject = ActiveSheet.Range("MailSubject")
        
        'ADD ATTACHMENTS
         strLocation = ActiveSheet.Range("AttachPath")
         strFileName = ActiveSheet.Range("AttachFileName")
         strFileExt = ActiveSheet.Range("AttachFileExt")
'
        .Attachments.Add strLocation & strFileName & strFileExt
        
        
        'IF SENT FROM ANOTHER EMAIL ACCOUNT (MUST ALREADY BE SETUP)
        .SentOnBehalfOfName = Application.Username
        
        'CHECK NAMES, ENSURES INTERNAL EMAIL ADDRESSES EXISTS IN ADDRESS BOOK
        .Recipients.ResolveAll
        .Display
        

        'GET THE HTML CODE FROM THE SIGNATURE
        strSig = .HTMLBody
        
        'CONVERT BODY IN HTML
        
        ActiveSheet.Range("MailBody").Copy
        ActiveSheet.Range("G9").PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Range("H9") = "=fnConvert2HTML(RC[-1])"
        
        strBody = ActiveSheet.Range("H9")
        
        
        'COMBINE THE EMAIL WITH THE SIGNATURE
        .HTMLBody = strBody & strSig
        
        
        'AUTOMATICALLY SEND EMAIL (IT WILL STILL BRIEFLY POPUP)
'        .Send
        
        ActiveSheet.Range("G9,H9").ClearContents
    
    End With
    
    On Error GoTo 0
    Set objOutMail = Nothing
    Set objOutApp = Nothing

End Sub

 

[cortexnotion]

Hi Bering,

If the account name that you wish to use will always be the same, and you have 'send as' permissions, you can just state the e-mail address:

.SentOnBehalfOfName = "john@aol.com"

 

[Bering]

Hi,

Thanks for your answer. I would be most grateful if you could indicate where in the code above I could insert that line.

Please also note that the macro displays the email without sending them automatically.

 

[cortexnotion]

Personally I would do:

.SentOnBehalfOfName = "john@aol.com"
.To = ActiveSheet.Range("MailDestinataries")
.CC = ActiveSheet.Range("CCMailDestinataries")
.BCC = ""
.Subject = ActiveSheet.Range("MailSubject")

To send the e-mail automatically change ".Display" to ".Send"

PS you can remove the BCC line if you don't need it.

 

[Bering]

Thank you so much, this seems to do the trick. However, there is a automatic signature associated to each account. The email now is displayed without any.

Any ideas on how I could amend the code in order for the email to display the signature associated to the "SentOnBehalfof"account?

 'GET THE HTML CODE FROM THE SIGNATURE
        strSig = .HTMLBody

Personally I would do:

.SentOnBehalfOfName = "john@aol.com"
.To = ActiveSheet.Range("MailDestinataries")
.CC = ActiveSheet.Range("CCMailDestinataries")
.BCC = ""
.Subject = ActiveSheet.Range("MailSubject")

To send the e-mail automatically change ".Display" to ".Send"

PS you can remove the BCC line if you don't need it.