Attaching email signature to exported pdf.

P

Padthelad

Board Regular
Joined
May 13, 2016
Messages
64
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I am using the following VBA code to attach export and attach a pdf to an email.

I would like to be able to attach the email signature of the person that sends the email from Excel. I intend to have different users send the email.

Any assistance anyone can provide is very much appreciated.

Thanks,

Pad

Code: 
Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   

    .Subject = CStr(Range("A8").Value)
    Dim Mailadress As String
Mailadress = CStr(Range("B40").Value)
.to = Mailadress
    .CC = "timberbuildings@*****"
    .body = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," & vbLf & vbLf _
          & "*****************************" & vbLf & vbLf _
          & "************************************." & vbLf & vbLf _
          & "*****************************************************." & vbLf & vbLf _
          & "Kind regards," & vbLf & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
.Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remeber to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Hi,

The trick is to:

► Display the email
► Save it as the signature
► Insert your own body
► Append the sig

Code: 
Sub AttachActiveSheetPDF()
  Dim IsCreated   As Boolean
  Dim i           As Long
  Dim PdfFile     As String
  Dim Title       As String
  Dim sig         As String
  Dim OutlApp     As Object
  Dim Mailadress  As String
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    .display
    sig = .body
    .Subject = CStr(Range("A8").Value)
    Mailadress = CStr(Range("B40").Value)
    .to = Mailadress
    .CC = "timberbuildings@*****"
    .body = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," & vbLf & vbLf _
          & "*****************************" & vbLf & vbLf _
          & "************************************." & vbLf & vbLf _
          & "*****************************************************." & vbLf & vbLf _
          & "Kind regards," & vbLf & vbLf _
          & Application.UserName & vbLf & vbLf _
          & sig
    .Attachments.Add PdfFile
    .Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remeber to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
If you want to add an HTML body instead of a pure text one then you will need to use HTMLbody throughout.
 
Upvote 0
RickXL said:
Hi,

The trick is to:

► Display the email
► Save it as the signature
► Insert your own body
► Append the sig

Code: 
Sub AttachActiveSheetPDF()
  Dim IsCreated   As Boolean
  Dim i           As Long
  Dim PdfFile     As String
  Dim Title       As String
  Dim sig         As String
  Dim OutlApp     As Object
  Dim Mailadress  As String
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    .display
    sig = .body
    .Subject = CStr(Range("A8").Value)
    Mailadress = CStr(Range("B40").Value)
    .to = Mailadress
    .CC = "timberbuildings@*****"
    .body = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," & vbLf & vbLf _
          & "*****************************" & vbLf & vbLf _
          & "************************************." & vbLf & vbLf _
          & "*****************************************************." & vbLf & vbLf _
          & "Kind regards," & vbLf & vbLf _
          & Application.UserName & vbLf & vbLf _
          & sig
    .Attachments.Add PdfFile
    .Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remeber to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
If you want to add an HTML body instead of a pure text one then you will need to use HTMLbody throughout.
Click to expand...

Hi,

Thank you for your response. The amendments don't quite work. Only the signature is displayed. I have tried defining the signature as an object, but I am having trouble inserting it at the end of the email body. I have tried a few different ways, but cant seem to have the signature on the email with the attchements.

Any further help is much appreciated.

Thanks,

Pad
 
Upvote 0
Apologies, I realise what you have done for me. I can have the signature attached as String (text) and it works fine, thank you. The signatures we have contain a logo (inserted image) and various other standard formatting. Is it possible to have this signature inserted after the main body of the email. I am hoping to have the signature inserted so it looks the same as an email sent directly from Outlook (not through VBA code).

Your help is appreciated.

Pad
 
Upvote 0
You will need to capture the HTMLbody, instead.

If you are lucky, tis might be OK:
Rich (BB code): 
Sub AttachActiveSheetPDF()
  Dim IsCreated   As Boolean
  Dim i           As Long
  Dim PdfFile     As String
  Dim Title       As String
  Dim sig         As String
  Dim OutlApp     As Object
  Dim Mailadress  As String
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    .display
    sig = .HTMLbody
    .Subject = CStr(Range("A8").Value)
    Mailadress = CStr(Range("B40").Value)
    .to = Mailadress
    .CC = "timberbuildings@*****"
    .HTMLbody = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," & vbLf & vbLf _
          & "*****************************" & vbLf & vbLf _
          & "************************************." & vbLf & vbLf _
          & "*****************************************************." & vbLf & vbLf _
          & "Kind regards," & vbLf & vbLf _
          & Application.UserName & vbLf & vbLf _
          & sig
    .Attachments.Add PdfFile
    .Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remember to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
However, the body you are currently inserting is text-only. You could convert it to HTML to get the full benefits of all the formatting options available to HTML. You can add background images, tables, change fonts and colours etc etc. Needless to say, all that extra functionality brings its own learning curve. It would improve the text wrapping of your emails, though, as the user changed the window size.

Regards,
 
Upvote 0
RickXL said:
You will need to capture the HTMLbody, instead.

If you are lucky, tis might be OK:
Rich (BB code): 
Sub AttachActiveSheetPDF()
  Dim IsCreated   As Boolean
  Dim i           As Long
  Dim PdfFile     As String
  Dim Title       As String
  Dim sig         As String
  Dim OutlApp     As Object
  Dim Mailadress  As String
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    .display
    sig = .HTMLbody
    .Subject = CStr(Range("A8").Value)
    Mailadress = CStr(Range("B40").Value)
    .to = Mailadress
    .CC = "timberbuildings@*****"
    .HTMLbody = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," & vbLf & vbLf _
          & "*****************************" & vbLf & vbLf _
          & "************************************." & vbLf & vbLf _
          & "*****************************************************." & vbLf & vbLf _
          & "Kind regards," & vbLf & vbLf _
          & Application.UserName & vbLf & vbLf _
          & sig
    .Attachments.Add PdfFile
    .Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remember to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
However, the body you are currently inserting is text-only. You could convert it to HTML to get the full benefits of all the formatting options available to HTML. You can add background images, tables, change fonts and colours etc etc. Needless to say, all that extra functionality brings its own learning curve. It would improve the text wrapping of your emails, though, as the user changed the window size.

Regards,
Click to expand...

Thank you for your amendments. It works really well for most of the functionality of the export to Outlook and inserting the signature in the format we desire. However, the formatting of the text body is lost. I realise this is because the body is in plain text as opposed to HTML. I am reluctanct to go down the HTML route as I am a complete novice with it. Is there any way to copy the formatting of the current text body? Text is double spaced, size 12 and Calibri font.

Thank you again,

Pad
 
Upvote 0
Unfortunately, if you want to use HTML I think it all has to be HTML. The good news is that it might just be a question of replacing the vbLF's with <p>'s.

How does this work for you?
Code: 
Sub AttachActiveSheetPDF()
  Dim IsCreated   As Boolean
  Dim i           As Long
  Dim PdfFile     As String
  Dim Title       As String
  Dim sig         As String
  Dim OutlApp     As Object
  Dim Mailadress  As String
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    .display
    sig = .htmlbody
    .Subject = CStr(Range("A8").Value)
    Mailadress = CStr(Range("B40").Value)
    .to = Mailadress
    .CC = "timberbuildings@*****"
    .htmlbody = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," _
          & "<p>*****************************" _
          & "<p>************************************." _
          & "<p>*****************************************************." _
          & "<p>Kind regards,"  _
          & "<p>" & Application.UserName  _
          & "<p>" & sig
    .Attachments.Add PdfFile
    .Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remember to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
If <p> is adding too much white space then try <br> instead.
W3Schools is an excellent resource for HTML: HTML Tutorial
Strictly, there should be </p> tags at the end of the paragraphs as well but it may work without.

Regards,
 
Upvote 0
RickXL said:
Unfortunately, if you want to use HTML I think it all has to be HTML. The good news is that it might just be a question of replacing the vbLF's with 's.

How does this work for you?
Code: 
Sub AttachActiveSheetPDF()
  Dim IsCreated   As Boolean
  Dim i           As Long
  Dim PdfFile     As String
  Dim Title       As String
  Dim sig         As String
  Dim OutlApp     As Object
  Dim Mailadress  As String
 
  ' Not sure for what the Title is
  Title = Range("B10")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
    .display
    sig = .htmlbody
    .Subject = CStr(Range("A8").Value)
    Mailadress = CStr(Range("B40").Value)
    .to = Mailadress
    .CC = "timberbuildings@*****"
    .htmlbody = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," _
          & "
*****************************" _
          & "
************************************." _
          & "
*****************************************************." _
          & "
Kind regards,"  _
          & "
" & Application.UserName  _
          & "
" & sig
    .Attachments.Add PdfFile
    .Attachments.Add "K:\***********\2016 CUSTOMER JOB FILES\Terms and Conditions 2016.pdf"
    

    On Error Resume Next
    .display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully exported to Outlook. Remember to press send!", vbInformation
    End If
    On Error GoTo 0
    
  End With
 
  Kill PdfFile
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub
If
is adding too much white space then try
instead.
W3Schools is an excellent resource for HTML: HTML Tutorial
Strictly, there should be
tags at the end of the paragraphs as well but it may work without.

Regards,
Click to expand...


Perfect! Thank you so much! It has been bugging for ages having to insert the signature each and every time. I can't thank you enough!

Now to give myself a HTML coding lesson...

Pad
 
Upvote 0
Padthelad said:
Now to give myself a HTML coding lesson...
Click to expand...
If you really want to scare yourself:

► Find an email message that has been sent using HTML
► Open it up
► Find the Move menu
► Select Move-->Actions-->Other Actions-->View Source

(Obviously, the View option will come under the Move menu. :confused: )

If you want to experiment, I think the main point is that you cannot uniquely specify a font and expect Outlook to use it. You need to think more generically. The user might not have that font, for instance, but would still want to view the email.

Enjoy!
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Modify VBA
Replies
9
Views
620
NVRensburg
N
C
  • Solved
VBA attach PDF to email stopped working
Replies
8
Views
1K
FormR
FormR
L
  • Locked
  • Question Question
How to stop VBA from creating pdf from drop-down list if the value is empty?
Replies
1
Views
304
Fluff
Fluff
J
  • Question Question
Email issue with .Attachments.Add PdfFile
Replies
0
Views
464
jayserna
J
Y
  • Solved
Create email with all currently selected sheets attached as individual pdf files
Replies
2
Views
360
Yamezz
Y

Forum statistics

Threads
1,223,956
Messages
6,175,607
Members
452,660
Latest member
Zatman

Share this page

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