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
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Maybe this then
Code:
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
 
Upvote 0
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
 
Upvote 0
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
and remove these lines

Code:
' Not sure for what the Title is
  Title = Range("A1")
 
Upvote 0
No worries, thanks for correcting the other lines...:pray:
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,530
Messages
6,114,162
Members
448,554
Latest member
Gleisner2

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