Send using a Different Outlook Email Account, attached PDF + Body + Signature.

GijoeBlack

New Member
Joined
Sep 22, 2021
Messages
23
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
Hello Again

@Zot has been kind and helpful on another VBA excel issue. Hoping him or someone else can resolve this mystery. I'm using Altered version of here. My ONLY challenge is that my Outlook has more than one account and it seems to be default to a account that I DONOT want to use to Send email FROM the attached PDF with pre-defined Body wSignature per link above. I have attempted to set the email account that I intend to use as "default" in Outlook but did not solve the issue. Some trial and error, am off the opinion its something to do with using HTML signature. I have also reviewed "rondebruin's" code to find and utilize 1st or 2nd etc item, but can't get it to work aka while SendUsingAccount works fine, it attaches PDF correct, populates "Body" fine but does not include the HTML Signature. Not sure if this has to do with how the variables are Dimmed.

NOTE: since the base code is from the link posted above aka "Create PDF from current sheet and email as attachment", I would prefer altered version to include ability to define either SendUsingAccount or SentonBehalfofName options.

I would like to thank in advance for your efforts. Look forward to response.

Joe.
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
I've never had any experience dealing with multiple accounts and not even tried using VBA to automate with Outlook .. ? ?
 
Upvote 0
I've never had any experience dealing with multiple accounts and not even tried using VBA to automate with Outlook .. ? ?
No sweat @Zot. I hope someone has that hands-on and will be able to point me in right direction. But thanks for your response.
 
Upvote 0
Hey @HaHoBe

Appreciate the suggestion. But yes I have attempted various ways to incorporate using different email account but of no help. If it helps below is the code am using. You will see have attempted various way [commented out].

VBA Code:
Sub create_and_email_pdf()
' Author - Philip Treacy  ::   http://www.linkedin.com/in/philiptreacy
' http://www.MyOnlineTrainingHub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook
' Date - 14 Oct 2013
' Create a PDF from the current sheet and email it as an attachment through Outlook

Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim strbody As String

'Dim oAccount As Outlook.Account

CurrentInv = ""
Title = Range("J4")
strbody = "<H2><B>Dear Valued Client</B></H2>" & _
              "I hope this finds you well. Enclosed please find your Invoice.<br>" & _
              "Please contact if you have any questions regarding this invoice.<br>" & _
              "You can also reach our billing & accounting team at: accounting@email.com.<br>" & _
              "<br><br><B>We thank you for your business.</B>"

' *****************************************************
' *****     You Can Change These Variables    *********

    EmailSubject = "Your Invoice# " & Range("J4").Value & " " & "Dated " & Range("J5").Value 'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = ActiveSheet.Range("C16")   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = ""
    Email_BCC = ""
           
' ******************************************************
    
    'Prompt for file destination
    With Application.FileDialog(msoFileDialogFolderPicker)
        
        If .Show = True Then
        
            DestFolder = .SelectedItems(1)
            
        Else
        
            MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
                
            Exit Sub
            
        End If
        
    End With

    'Current month/year stored in H6 (this is a merged cell)
    'CurrentMonth = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1)
    
    'Current Invoice Number stored in J4
    CurrentInv = ActiveSheet.Range("J4").Value
    
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & "Your - " & "INV" & "_" & CurrentInv & "_" & ActiveSheet.Name _
                 & ".pdf"

    'If the PDF already exists
    If Len(Dir(PDFFile)) > 0 Then
    
        If AlwaysOverwritePDF = False Then
        
            OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
        
            On Error Resume Next
            'If you want to overwrite the file then delete the current one
            If OverwritePDF = vbYes Then
    
                Kill PDFFile
        
            Else
    
                MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
                
                Exit Sub
        
            End If

        Else
        
            On Error Resume Next
            Kill PDFFile
            
        End If
        
        If Err.Number <> 0 Then
        
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
                
            Exit Sub
        
        End If
            
    End If
   

    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating

    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        signature = OutlookMail.Body
    Set oAccount = "another@email.com"
        
    'Display email and specify To, Subject, etc
    With OutlookMail
        
        .Display
        .SendUsingAccount = oAccount
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
        .HTMLBody = strbody & "<br>" & .HTMLBody
        
       'Set .SendUsingAccount = OutlookApp.Session.Accounts.Item(1)
       'Set .SentOnBehalfOfName = "another@email.com"
        
        If DisplayEmail = False Then
            
            .Send
            
        End If
        
    End With
    
 
End Sub
 
Upvote 0
Hi GijoeBlack,

your code shows the line
Code:
    Set oAccount = "another@email.com"
while in Ron de Bruin´s example it should be
Code:
    Set oAccount = OutlookApp.Session.Accounts("another@email.com")
I tested the sample of Ron, and for me in Office2013 a mail with the proper account as sender was generated.

Ciao,
Holger
 
Upvote 0
Hi GijoeBlack,

your code shows the line
Code:
    Set oAccount = "another@email.com"
while in Ron de Bruin´s example it should be
Code:
    Set oAccount = OutlookApp.Session.Accounts("another@email.com")
I tested the sample of Ron, and for me in Office2013 a mail with the proper account as sender was generated.

Ciao,
Holger
Apparently if I were to use standalone code from Ron, it works as expected. However the real test is to use the above code example that creates, saves PDF and includes HTML Body along with preset Signature, that is where it does not work. You are welcome to test the code above by replacing some reference values. You must test along with Signature, that is where the account switchover does not work. BTW I did make necessary changes to the code as pointed out by you, but had no luck.

Any other thoughts ... thanks again though :)
 
Upvote 0
Hi GijoeBlack,

maybe it´s because you assign the body before trying to change the sender which should get the main address as sender. I´m nott able to get the code working with SendUsingAccount but could get it working by using SentOnBehalfOfName. Maybe give it a try.

Original code looks like
Code:
'...
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        Signature = OutlookMail.Body
    Set oAccount = "another@email.com"
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
        .Display
        .SendUsingAccount = oAccount
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
        .HTMLBody = strbody & "<br>" & .HTMLBody
'...
The altered code looks like
Code:
'...
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
        .SentOnBehalfOfName = "another@email.com"
        .Signature = .Body
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
        .HTMLBody = strbody & "<br>" & .HTMLBody
'...
Holger
 
Upvote 0
Hi GijoeBlack,

maybe it´s because you assign the body before trying to change the sender which should get the main address as sender. I´m nott able to get the code working with SendUsingAccount but could get it working by using SentOnBehalfOfName. Maybe give it a try.

Original code looks like
Code:
'...
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        Signature = OutlookMail.Body
    Set oAccount = "another@email.com"
      
    'Display email and specify To, Subject, etc
    With OutlookMail
      
        .Display
        .SendUsingAccount = oAccount
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
        .HTMLBody = strbody & "<br>" & .HTMLBody
'...
The altered code looks like
Code:
'...
    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
      
    'Display email and specify To, Subject, etc
    With OutlookMail
      
        .SentOnBehalfOfName = "another@email.com"
        .Signature = .Body
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
        .HTMLBody = strbody & "<br>" & .HTMLBody
'...
Holger
Alright. That sounds good. I will give it a go. Thanks so much for lending a hand here.. I will report back to you :)
 
Upvote 0
Alright. That sounds good. I will give it a go. Thanks so much for lending a hand here.. I will report back to you :)
Ok seems to be working fine. However, seems like the MB does not suppose Send on Behalf of Name. So need to get SendUsingAccount working for my use case. Let me know if you have any more thoughts.

Cheers
 
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,739
Members
448,989
Latest member
mariah3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top