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

[aarondesin91]

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

 

[Padthelad]

This thread is great. Worked for almost exactly what I needed. I used the code ZVI used and also amended it to 'display' instead of 'send'. I would like to enter an email address from cell C40 in to the email. What is the code for this?

Thanks,

Pad

 

[ZVI]

Hi Pad,
This part of code (see in red & bold) will get email address from C40

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
 
    ' Prepare e-mail
    .Subject = Title
    .To = Range("C40").Value    ' It is assumed the list of recipient emails is in C40

Regards

 

[Colmans]

Gents

Thanks for your input. The code has been really helpful. I have used ZVI's original code and tweeked it slightly so it creates and names a pdf based on a range in my spreadsheet. However, I'd like to be able to do the following two things to the code:


1. Save the pdf file to a network address
2. Incorporate a date in the file name when originated, preferably the date it is sent, but also an option for the date being selected from a cell in my worksheet

Sub SendQuoteEmail()
  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 = ActiveSheet.Range("H9")
 
  ' Define PDF filename
   PdfFile = ActiveSheet.Range("H9") & ".pdf"
  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 & " ABN AMRO Lease Settlement"
    .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
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail not created", vbExclamation
    Else
      MsgBox "E-mail ready to send", 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

 

[MilkyTech]

Try this (you will need to adjust the email body content):

Sub AttachPdfSaveNetwork()
  Dim IsCreated As Boolean
  Dim PdfFile As String, EmailSubject As String, SavePath As String
  Dim OutlApp As Object
  Dim sendTime As String


    sendTime = Now()
    sendTime = Format(sendTime, "yyyy-mm-dd-hhmmss")


  ' ### Define email subject and PDF path & filename ###
  
  EmailSubject = sendTime & "_" & ActiveSheet.Range("H9")
  
  SavePath = "Z:\MyNetworkFolder\"
  If Dir(SavePath, vbDirectory) = vbNullString Then
      MkDir SavePath
  End If
  
  PdfFile = SavePath & EmailSubject & ".pdf"
  
  ' ### Export ActiveSheet to PDF ###
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With


  ' ### Open Outlook ###
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")  '<-- If open, use it
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")  '<-- If not, open it
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0


  ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)


    .Subject = EmailSubject & "_ABN AMRO Lease Settlement"
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile


    ' Try to send
    Application.Visible = True
    .Display
  End With


  If IsCreated Then OutlApp.Quit  '<-- Quit Outlook if it was not already open
  Set OutlApp = Nothing  '<-- Release the memory of object variable




End Sub

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">
</code>

 

[Colmans]

Milky, thanks for your help. It works great and i've been able to enhance it by expirmenting with your code.

The last thing I need is to be able to have the code insert the default outlook e-mail signature (non HTML) for the user executing the code. The current code uses the network user name which for me is a string of numbers and letters. I have been able to adjust the code so that no signature is used and this would require the user to manually attach their, but I wanted to avoid creating individual files for users and just have one network file.

Thanks in advance

 

[MilkyTech]

This is the simplest way, but the user's signature must be associated with the Default Outlook Account.
For some reason, the signature will not get added if you display the email after filling it out, so we just need to move .Display to the beginning of the email creation then add .Body to the end of the email body like so:

 ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)


    .Display     '<-- This needs to be first for the signature to be added

    .Subject = EmailSubject & "_ABN AMRO Lease Settlement"
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf _
          & .Body       '<-- This adds the signature

    .Attachments.Add PdfFile



    Application.Visible = True

  End With

 

[ZVI]

Edit html code which are not displayed in forum, please wait

 

[ZVI]

Html tags are still not displayed properly...

 

[ZVI]

Below is the code to send active sheet as PDF with the default email signature.
It does not use a popular but blinking .Display method for adding signature. No blinking at all.
There are Boolean configuration constants on the top of the code: IsHtml, IsDisplay, IsSilent - reed the comments for more details.

Sub Attach_ActiveSheet_As_Pdf_With_Signature()
' ZVI:2016-05-31 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-4.html#post4537766
 
  ' --> User settings, change to suit
  Const IsHtml As Boolean = False     ' Change to True for HTML body of email
  Const IsDisplay As Boolean = False  ' Change to True to .Display instead of .Send
  Const IsSilent As Boolean = False   ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim MailSubject As String, PdfFile As String, s As String
  Dim HtmlSignature As String, Signature As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Subject of the email, choose one of two below lines
  'MailSubject = Range("A1") & " " & Date
  MailSubject = "Report on " & Date
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  ' Clean up the name of PDF file
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit too long name
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Try to delete PDF file for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill 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
 
  ' Use the 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 email with PDF attachment and default signature
  With OutlApp.CreateItem(0)
   
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
   
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    If IsHtml Then HtmlSignature = .HTMLBody Else Signature = .Body
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = MailSubject
    '.To = "..." ' <-- Put email(s) of the recipient(s) here
    '.CC = "..." ' <-- Put email of 'copy to' recipient(s) here
   
    ' Edit the body's text or html text as required
    If IsHtml Then
      ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
      ' HTML tag's brakets are not displayed properly in the forum post, thus replacing in s is used to fix this problem
      s = "(h3)(b)Dear Customer,(/b)(/h3)" _
          & "This e-mail was created by the code of this post - " _
          & "(a HREF=""http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-4.html#post4537766"")Attach_ActiveSheet_As_Pdf_With_Signature(/a)" _
          & "(br /)" _
          & "(b)The report is attached in PDF file(/b)"
      s = Replace(s, "(", "<")
      s = Replace(s, ")", ">")
      .HTMLBody = s & HtmlSignature
    Else
      .Body = "Dear Customer," _
          & vbLf & vbLf _
          & "This e-mail was created by the code of this post:" _
          & vbLf _
          & "http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-4.html#post4537766" _
          & vbLf & vbLf _
          & "The report is attached in PDF file" _
          & Signature
    End If
   
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
    
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub

 

[ncampo]

Thanks for the amazing code! Worked perfect! I have 2 questions.

1. Is there a way to insert yesterdays date in the subject line? I would like it to state the subject and then yesterdays date.

2. When the macro creates the PDF, Adobe Reader opens. It completes the email, but AR stays open.

I have worked around both of these, but a permanent fix would be nice.
Again, thanks the the great code and great site!