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

A

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
 
Sort by date Sort by votes
ncampo said:
...Worked perfect! I have 2 questions...
Click to expand...
You are welcome, and thank you for the feedback.

To your questions:

1. To insert the yesterday's date in the subject line just subtract one day (numerically it's equal to 1) from the Date like this:
MailSubject = "Report on " & Date– 1

You may also use Format function, for example:
MailSubject = "Report on " & Format(Date - 1,"mmm d, yyyy")

2. To prevent opening of Adobe Reader when macro creates the PDF there is special argument in the code of the post #159 (see below in red):
.ExportAsFixedFormat ... OpenAfterPublish:=False

Please check this argument in your code

Regards,
 
Upvote 0

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Works great. Kudos.
ZVI said:
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
Click to expand...
 
Upvote 0
Also had question as:
I have an excel file with sheets named as A, B, C, Main;
Main sheet has two columns viz., sheet_name and email_address;
sheet_name email_address
A abc@xyz.com
B efg@xyz.com
and so on(list of all the sheets of the workbook it belongs to and respective email address for each sheet listed in email_address column).
I want the code to read the sheet_name from the Main sheet, go to respective sheet, convert to pdf and attach to email and send.
how could the mentioned code be modified?
Help would be appreciated!
Thanks and regards,
Aru_Sidd
ZVI said:
The template code for Excel 2007+ with its own PDF converter:
Click to expand...
 
Upvote 0
ZVI said:
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
Click to expand...

Please can you help, I copied and pasted this code and edited it for my preferences, but it keeps telling me Email not sent?

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("$B$59")

' 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 = Range("$I$15")
.To = "..." ' <-- Put email of the recipient here
.CC = "creditors@junkshop.co.za" ' <-- Put email of 'copy to' recipient here
.Body = "Good Day," & vbLf & vbLf _
& " " & vbLf _
& "Please find attached your payment remittance in PDF format." & vbLf & vbLf _
& "Should you have any querier, please do not hesitate to contact me." & vbLf _
& " " & vbLf _
& "Kind Regards," & vbLf _
& "Natasha van Rensburg," & vbLf _
& "Creditors Administrator," & vbLf _
& "Junk Shopping Centre," & 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
 
Upvote 0
Hello,

I have tailored the original code posted by ZVI to suit my needs. Everything runs correctly until I get to the line " Attachment.add PdfFile"

I receive a runtime error stating:
Run-time error '-2147024894(80070002)':
Cannot find this file. Verify the path and file name are correct.

here is my current code:
Code: 
Sub Compile_PDF_AND_EMAIL()
  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 = ThisWorkbook.Sheets("Cover Sheet").Range("E18").Value
 
  ' Define PDF filename
  PdfFile = ThisWorkbook.Sheets("Cover Sheet").Range("B2").Text
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  'PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
  PdfFile = PdfFile & ".pdf"
 
  ' Export activesheet as PDF
  
With Workbooks("UW Production Report Full Raw Test")
    
    Workbooks("UW Production Report Full Raw Test").Activate

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    ActiveWorkbook.Sheets(Array("Daily UW Output")).Select
    
End With
    
    Workbooks("UW Production Report Cover Sheet").Activate
 
  ' 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 = ThisWorkbook.Sheets("Cover Sheet").Range("E16").Value ' <-- Put email of the recipient here
    .CC = ThisWorkbook.Sheets("Cover Sheet").Range("E17").Value
    .Body = "Team," & vbLf & vbLf _
          & "Below you will find the " & ThisWorkbook.Sheets("Cover sheet").Range("E18").Value & vbLf & vbLf _
          & "Please let me know if you have any questions or concerns" & vbLf & vbLf _
          & "Thank you," & vbLf & vbLf
[B]    [COLOR="#FF0000"].Attachments.Add PdfFile[/COLOR][/B]
   
    ' Try to send
    On Error Resume Next
    '.Send
    .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

any help will be greatly appreciated
 
Last edited:
Upvote 0
Vladimir, tks for your script.

I Need to get the mail to from a cell on the sheet.

I did a test inserting my own email, and it returned "email not sent". What could be wrong?

Tks a lot!
 
Upvote 0
CarlosPetersen said:
Vladimir, tks for your script.

I Need to get the mail to from a cell on the sheet.

I did a test inserting my own email, and it returned "email not sent". What could be wrong?

Tks a lot!
Click to expand...
If email address is in the cell A1 then uncomment this line of the code:
'.To = "..." ' <-- Put email(s) of the recipient(s) here
and replace "..." by Range("A1").Value
so that line becomes:
.To = Range("A1").Value

To check what is wrong in the sending use .Display instead of the .Send and try manual sending.
 
Last edited:
Upvote 0
NVRensburg said:
Please can you help, I copied and pasted this code and edited it for my preferences, but it keeps telling me Email not sent?
Click to expand...

bscott05 said:
Hello,

I have tailored the original code posted by ZVI to suit my needs. Everything runs correctly until I get to the line " Attachment.add PdfFile"

I receive a runtime error stating:
Run-time error '-2147024894(80070002)':
Cannot find this file. Verify the path and file name are correct.
...
any help will be greatly appreciated
Click to expand...
Hope you've found the solution. Just for the case it's not I'd suggest using of more safety code, for example of post#43 where illegal symbols in PDF file name are replaced by the symbol "_", and length of PDF pathname is limited by 255 chars in this (in red) part of that code:
Rich (BB code): 
  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
 
Last edited:
Upvote 0
Very thank you again Vladimir

Just a last question: and if I want to use on the subject, or email body, how can I use the script to take a cell content?

Thankyou!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Save outlook attachment without file extensions
Replies
3
Views
478
johnnyL
J
A
  • Question
Outlook File Attachment using VBA
2 3
Replies
22
Views
1K
RoryA
RoryA
B
  • Question
Printing Excel Tabs to Adobe PDF
Replies
2
Views
93
boonwd
B
A
  • Question
VBA to Match the 6 digit code in the email subject line with the same code in the name of the attachments
Replies
0
Views
236
Abhishekghorpade
A
T
  • Question
After VBA code to print .pdf documents in outlook
Replies
0
Views
384
Thomo4321
T

Forum statistics

Threads
1,214,808
Messages
6,121,684
Members
449,048
Latest member
81jamesacct

Share this page

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