VBA code to convert excel to pdf and email it as attachment

aarondesin91

New Member
Joined
Jun 23, 2013
Messages
7
Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you
 
Re: convert worksheet to pdf, save, and attach to email

Wanted to thank all of the contributors of this thread! I was able to take bits and pieced to help accomplish something I needed. Thanks again!
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Re: convert worksheet to pdf, save, and attach to email

This works great for me since I use Outlook on Windows, but my boss is on a MAC. Can this be easily modified for the OS X email client? Or better yet, be modified for whatever the default mail client may be?
Also, I am still hoping someone can answer my question from Posts #80/#81.
 
Upvote 0
Re: convert worksheet to pdf, save, and attach to email

What you have put already has been amazing. But I am trying to send a sheet as a PDF and wanting it not to just send as an attachment but as soon as you open the email it will show up. Can I just send the excel sheet as a PDF that way or will it have to be as an attachment?
 
Upvote 0
Re: convert worksheet to pdf, save, and attach to email

What you have put already has been amazing. But I am trying to send a sheet as a PDF and wanting it not to just send as an attachment but as soon as you open the email it will show up. Can I just send the excel sheet as a PDF that way or will it have to be as an attachment?
I don't believe you can do exactly what you are asking. You cannot have a pdf in the body of an email. You can copy data from the pdf and paste it in the body, but it will lose formatting.

It would depend on the email client of the person opening the email whether or not a pdf attachment will be previewed. I know mac mail will automatically preview pdf attachments. With outlook, even if you have the correct selection for previewing pdf's, you still need to click on the attachment to preview it.

Instead, this code below I threw together is a combination of ZVI's, Ron de Bruin's, byundt's, and some of my own. It will:
  • Save a pdf of the "Print Area" to the same folder the workbook is saved in
  • Attach a copy of the pdf to an Outlook email
  • Copy the current selection from the worksheet to the body of the email (this is the part you are looking for, unfortunately does not copy images such as a company logo)
  • Open the pdf (change OpenAfterPublish:True to False if you dont want this step)
  • Display the email for review before sending
You can customize this anyhow you like:
Code:
Sub pdfAndEmail()    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim RngCopied As Range
    Dim IsCreated As Boolean
    Dim PdfFile As String, Title As String
    Dim i As Long
    Dim char As Variant


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    Set RngCopied = Selection
    
     ' Change to suit
  'Title = Range("A1") & " " & Date
  Title = ActiveSheet.Range("B11").Value & " Submittal"
 
  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = Title
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Export activesheet as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  End With
  
    'On Error Resume Next
    With OutMail
        .To = "johndoe@gmail.com" ' Either an email address or a cell value that contains an email address: ActiveSheet.Range("B11").Value
        .CC = ""
        .BCC = ""
        .Subject = ""
        .HTMLBody = RangetoHTML(RngCopied)
        .Display  ' Change this to Send if you want to automatically send it without preview
        .Attachments.Add PdfFile  ' Delete this line if you don't want the attachment
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub



Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Upvote 0
The template code for Excel 2007+ with its own PDF converter:
Rich (BB 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("A1")
 
  ' 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)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub

Hi ZVI,

Would you be able to help with the following in relation to the above code?

How do I get the colours to also transfer? there are some figures/words in red (the rest is black font) that are transferring to pdf in black using the above code.

Thanks in advance for your assistance :)
 
Upvote 0
Thank you so much for providing this code. It worked for me (with the Title- Range ("A2") - i was able to export a form and it was opened as an attachment in the email.

however, when I ask my brother to try to file - he got a different result
(he's also using Excel 2010). After he clicked on the Button (where i attached the module), Excel prompt him to select a printer (and ADOBE PDF is one of the option), after he selected the Printer (and) the Adobe PDF the second time, he got an Run Time error message.

Any suggestions on how to make this work?


Try this:
Rich (BB code):
Sub AttachActiveSheetPDF_01()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
 
  ' Define PDF filename
  Title = "Request Form for " & Range("A1").Value
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".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)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "See the attached requiest in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    Application.Visible = True
    .Display
  End With
 
  ' Quit Outlook if it was not already open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub
 
Upvote 0
when I ask my brother to try to file - he got a different result
When he gets the runtime error, have him click on "debug" to see what line in the code is causing the error.
You can try this code that I use. It will save the pdf to the same folder as the excel doc before attaching it to the email. The comments should explain everything that the code is doing. If this works for you and not your brother then I would venture to guess that his computer is not configured properly for the code to work.
Code:
Sub ConvertAttachPDF()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, signature As String
  Dim OutlApp As Object 
 
  Title = Range("B9")      ' Change or eliminate to suit your needs.  I use this value only for filling out the subject line of the email.

' Set pdf filename and path to folder where excel doc is currently saved
    With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & _
              .Sheets("Current Sheet Name Here").Range("B9") & ".pdf"   ' I am using the value of cell B9 for my filename.
    End With
 
' Export activesheet as PDF to the current folder  
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True   ' Change this to False if you don't want to preview the created pdf
  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
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    .Display         ' We need to display the email first for the signature to be added
    .Subject = Title
    .To = ActiveSheet.Range("E10").Value ' <-- Put email of the recipient here
    .CC = "anyone@abc.com; someone@abc.com" ' <-- Put email of 'copy to' recipients here
    .Body = "Blah blah blah blah blah." & _
        vbNewLine & vbNewLine & _
        "Thank you," & _
        .Body      ' Adds default signature
    .Attachments.Add PdfFile   
   
    On Error Resume Next
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
    End If
    On Error GoTo 0
 
  End With 
  
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
End Sub
 
Upvote 0
When I run this macro and Outlook is open everything works great. When Outlook is not open it still creates the email but the attachment does not get added and when i switch back to Excel I get this runtime error.
7dQ7kOK.png


When I debug it references attachments.add PdfFile. Here is my code.

Code:
Sub EmailPDFtoDealer()  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object


 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = "Weekly Performance Review " & Date & " - " & ActiveSheet.Range("C3").Value
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(PdfFile, 251) & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat To:=1, 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)
   
    ' Prepare e-mail
    .Display
    .Subject = "Weekly Performance Review " & Date & ":  " & Range("C3")
    .To = ActiveSheet.Range("$R$6") ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello " & ActiveSheet.Range("C3").Value & "," & vbLf & vbLf _
          & "Your Weekly Performance Review is attached in PDF format." & vbLf & vbLf & _
          .Body
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

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