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

 

[aarondesin91]

Thank alot michael...How about the others in my reply above. could you help me??

 

[Michael M]

Which code are you using ??

 

[aarondesin91]

I am using the ZVI's code because i dont have acrobat to use your code.

 

[Michael M]

Maybe this then

Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long, DesktopPath As String
  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 = PdfFile & "_" & ActiveSheet.Name & ".pdf"
     ' Not sure for what the Title is
  Title = "Request Form for " & Range("A1").Value

  
  Set WSHShell = CreateObject("WScript.Shell")
    DesktopPath = WSHShell.SpecialFolders("Desktop")
    Set WSHShell = Nothing

    ThisWorkbook.SaveAs Filename:=DesktopPath & "\" & Title, FileFormat:=xlOpenXMLWorkbookMacroEnabled

  ' 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 or Display
    On Error Resume Next
    .Display
    '.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

 

[aarondesin91]

hey bro,

I have some problem with the code you gave. When I run the code it say "Compile Error..Variable not defined"..Highlighted blue on "WSHShell" and highlighted yellow on "Sub AttachActiveSheetPDF()". How do i solve this bro??

Thanks in advantance

 

[ZVI]

Try this:

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

 

[Michael M]

and remove these lines

' Not sure for what the Title is
  Title = Range("A1")

 

[ZVI]

and remove these lines

It's true, thank you Michael!

 

[Michael M]

No worries, thanks for correcting the other lines...ray:

 

[audrey]

Hello, this is a great code! thanks for sharing. Is it possible to return to the Outlook screen after clicking the button ? it is a little confusing to say email is sent, but it is actually outstanding as a draft.