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

 

[ZVI]

How do I change this code for a Word Document, I have a Word Document on my desktop and I like to convert and attach it to Outlook? Here is the location C:\Users\Admin\Desktop

The previous code was for storing in VBA module of Excel’s workbook, add-in or personal workbook.
So, where the code for WinWord have to be stored and run from?

 

[lapot]

Thanks for your reply but I have an excel report which has Sql invoices locations on column D. I was hoping to start the invoice from that location then convert to PDF and attach it to outlook. My invoices are in word format. Basically I like this code run from excel sheet and start word document then convert PDF before attaching it to an email. Is it possible?

 

[ZVI]

Well, try this:

Sub AttachActiveSheetPDF_03()
' Copy this code to the module of any Excel's workbook.
' Prepare report/invoice in MyReport.doc or MyReport.docx and store it on Desktop
' This macro exports the report document to PDF and attaches that PDF to Outlook's email
 
  Dim IsOutlCreated As Boolean, IsWordCreated As Boolean, IsDocOpen As Boolean
  Dim DesktopPath As String, DocFile As String, PdfFile As String, Title As String, s As String
  Dim OutlApp As Object, WordApp As Object
  Dim i As Long
  Dim char As Variant
  Const wdExportFormatPDF = 17
 
  ' --> Settings, change to suit
  Const WordDocument = "MyReport.doc"
  'Title = Range("A1") & " " & Date
  Title = "PU: " & Date
  ' <-- End ofsettings
 
  ' Check WordDocument presence on Desktop
  DesktopPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
  DocFile = DesktopPath & "\" & WordDocument
  s = Dir(DocFile & "*")
  If s = "" Then
    MsgBox "Word Report file not found:" & vbLf & DocFile, vbExclamation, "Exit"
    Exit Sub
  End If
  DocFile = DesktopPath & "\" & s
 
  ' Define PDF filename in TEMP folder
  PdfFile = WordDocument
  i = InStrRev(PdfFile, ".", , vbTextCompare)
  If i > Len(PdfFile) - 6 Then PdfFile = Left(PdfFile, i - 1)
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Delete PDF file - for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Open WordDocument if it was not open previously
  On Error Resume Next
  Set WordApp = GetObject(, "Word.Application")
  If Err Then
    Set WordApp = CreateObject("Word.Application")
    IsWordCreated = True
  End If
  Err.Clear
  WordApp.ScreenUpdating = False
  With WordApp.Documents(s): End With
  IsDocOpen = Err = 0
  On Error GoTo 0 'exit_
  If Not IsDocOpen Then
    WordApp.Documents.Open Filename:=DocFile, ReadOnly:=IsWordCreated
  End If
 
  ' Export activedocument as PDF to the temporary folder
  WordApp.Documents(s).ExportAsFixedFormat OutputFileName:=PdfFile, ExportFormat:=wdExportFormatPDF
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsOutlCreated = True
  End If
  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 invoice is attached in PDF file" & vbLf & vbLf _
          & "Best Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send ' or use .Display
   
    ' Return focus to Excel's window
    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
 
exit_:
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Close WordDocument if it was open via this macro
  If IsDocOpen Then
    WordApp.Documents(s).Close False
  Else
    WordApp.ScreenUpdating = True
  End If
 
  ' Close WordApp if it was open via this macro
  If IsWordCreated Then WordApp.Quit: Set WordApp = Nothing
 
  ' Try to quit Outlook if it was not previously open
  If IsOutlCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
 
  If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number
 
End Sub

 

[Wiss3]

Hello Guys,

Am new to this forum. Thank you for the VBA code.
Would someone be able to help with this? Instead of typing the recipient's email address in the code, i want the macro to lookup a list/cell within the same workbook and fetch the email address automatically (where i will have changing recipient addresses based on content changes).

Appreciate your help.

Wiss

 

[ZVI]

... Instead of typing the recipient's email address in the code, i want the macro to lookup a list/cell within the same workbook and fetch the email address automatically (where i will have changing recipient addresses based on content changes).

Hi and welcome to MrExcel Message Board!

Uncomment the line of code with .To = "..."
and write it something like this: .To = Range("A1").Value
or: .To = ActiveCell.Value
or for 2 recipients in cells A1:A2: .To = Range("A1").Value & ";" & Range("A2").Value
and so on

Regards,

 

[Wiss3]

Thank you Vlad!

 

[Sweety sweety]

Hi,

I am working on the similar project as well.
But I continuously have the same problem.
The problem is when the excel sheet attachment final seperate out from it , I am unable to open the attachment.
I found out that the size of the attachment have reduce a lot but not sure what is the root cause.
The error message is : There was an error opening this document. The root object is missing or invalid.

For example:
I attach a pdf file in the excel sheet. The original size of the pdf is 48 KB. When it final confirm, the pdf attachment will seperate out, but the file size reduce to 4 KB.

Anyone know how to solve it ?

Thank you.

 

[zeheckman]

The template code for Excel 2007+ with its own PDF converter:

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

how would i take this code, and use it to email only select sheets using check boxes on the user form this code is tied to the button click on?

for example, i have 4 check boxes on the userform. i check one of them to add sheet 1 only, and then click the command button send email. can this code be tied to that check box to only send sheet 1 as a pdf?

 

[ZVI]

for example, i have 4 check boxes on the userform. i check one of them to add sheet 1 only, and then click the command button send email. can this code be tied to that check box to only send sheet 1 as a pdf?

That code if for attaching of active sheet only
You can activate the required sheet and sent it like this:

  If CheckBox2.Value = True Then
    Sheets(2).Activate
    Call AttachActiveSheetPDF
  End If

 

[zeheckman]

That code if for attaching of active sheet only
You can activate the required sheet and sent it like this:

  If CheckBox2.Value = True Then
    Sheets(2).Activate
    Call AttachActiveSheetPDF
  End If

10-4,

how would i combine that code with my email code on the command button click?

Command button click,

im not quite sure what to take out of the code to add this line in.

im guessing something like this?

Private Sub CommandButton1_Click()

  If CheckBox1.Value = True Then     Sheets(1).Activate     Call AttachActiveSheetPDF   End If
  If CheckBox2.Value = True Then     Sheets(2).Activate     Call AttachActiveSheetPDF   End If
  If CheckBox3.Value = True Then     Sheets(3).Activate     Call AttachActiveSheetPDF   End If
  If CheckBox4.Value = True Then     Sheets(4).Activate     Call AttachActiveSheetPDF   End If

  ' 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

</pre>


</pre>