• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

How to Modify VBA to Create 2 PDFs from specific sheets in one workbook and send both PDFs in one email|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / How to Modify VBA to Create 2 PDFs from specific sheets in one workbook and send both PDFs in one email|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosHow to Modify VBA to Create 2 PDFs …
sp_PrintTopic sp_TopicIcon
How to Modify VBA to Create 2 PDFs from specific sheets in one workbook and send both PDFs in one email
Avatar
Janah Fleury

New Member
Members
Level 0
Forum Posts: 2
Member Since:
February 14, 2021
sp_UserOfflineSmall Offline
1
February 14, 2021 - 12:31 am
sp_Permalink sp_Print sp_EditHistory

Hi there, 

I'm a VBA noobie and truly appreciate everyone's expertise here. I've searched through the forums, but I think it's just easier (and faster) to ask for help 🙂

 

I'm trying to modify this code to do the following:

Create one PDF of the Worksheet 'Refund Request Form'. The file name would be Range F8 & A11

Create a second PDF combining Worksheets 'Refund Log for Print' (Hidden Worksheet), 'Supporting Docs' and 'IFIS Print Screens'. The file name would be F8 & A11 & "Backup"

Both PDF documents would be saved in the same folder and I would like to send them in one email. 

 

I wish I had a better understanding of VBA :S

Thanks for your help!!

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1807
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
2
February 15, 2021 - 8:22 pm
sp_Permalink sp_Print sp_EditHistory

Hi Janah,
In Module2 you have code that can be easily modified to what you need:

This section:

PDFFile = PDFFile & ".pdf"

' Export activesheet as PDF
With ActiveWorkbook
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

Needs to be replaced with:

PDFFile = ThisWorkbook.Worksheets("Refund Request Form").Range("A11") & "-" & ThisWorkbook.Worksheets("Refund Request Form").Range("F8") & ".pdf"
Dim PdfFileBackup As String: PdfFileBackup = "Backup-" & PDFFile & ".pdf"

ThisWorkbook.Worksheets("Refund Request Form").ExportAsFixedFormat Type:=xlTypePDF, FileName:=ThisWorkbook.Path & Application.PathSeparator & PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ThisWorkbook.Worksheets("Refund Log for Print").Visible = True
ThisWorkbook.Worksheets(Array("Refund Log for Print", "Supporting Docs", "IFIS Print Screens")). _
ExportAsFixedFormat Type:=xlTypePDF, FileName:=ThisWorkbook.Path & Application.PathSeparator & PdfFileBackup, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ThisWorkbook.Worksheets("Refund Log for Print").Visible = False

 

You will now be able to attach the second pdf :
.Attachments.Add PDFFile
.Attachments.Add PdfFileBackup

Avatar
Janah Fleury

New Member
Members
Level 0
Forum Posts: 2
Member Since:
February 14, 2021
sp_UserOfflineSmall Offline
3
February 17, 2021 - 7:20 am
sp_Permalink sp_Print

Hi Catalin, 

Thanks so much for your response.

I realized I had included Modules that I am not using (recycled from various brainstorming ideas I was attempting to put into place.)

To avoid confusion, I reloaded a new workbook with the only Module that I intend on using.  Except I don't know how to remove the old one lol (I'm such a newb). 

If you have time to take a look at the new upload and could provide some guidance, that would be swell!!

 

Thanks again for helping us newbies!

Cheers, 

janah

Avatar
Catalin Bombea
Iasi, Romania
Admin
Level 10
Forum Posts: 1807
Member Since:
November 8, 2013
sp_UserOfflineSmall Offline
4
February 18, 2021 - 2:05 am
sp_Permalink sp_Print

Here is the updated code:

Option Explicit

Sub Create_and_Email_PDF()
' Author - Philip Treacy :: http://www.linkedin.com/in/philiptreacy
' http://www.MyOnlineTrainingHub.....th-outlook
' Date - 14 Oct 2013
' Create a PDF from the current sheet and email it as an attachment through Outlook

Dim EmailSubject As String, EmailSignature As String
Dim RefundNum As String, DestFolder As String, PDFFile As String 'changed CurrentMonth to RefundName"
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object, signature As String
RefundNum = ""

' *****************************************************
' ***** You Can Change These Variables *********

EmailSubject = "Revenue Refund for Verification - " 'Change this to change the subject of the email. The current month is added to end of subj line
OpenPDFAfterCreating = False 'Change this if you want to open the PDF after creating it : TRUE or FALSE
AlwaysOverwritePDF = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
DisplayEmail = True 'Change this if you don't want to display the email before sending. Note, you must have a TO email address specified for this to work
Email_To = "revenue.sudbury@ontario.ca" 'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
Email_CC = ""
Email_BCC = ""

' ******************************************************

'Prompt for file destination
' With Application.FileDialog(msoFileDialogFolderPicker)
'
' If .Show = True Then
'
' DestFolder = .SelectedItems(1)
'
' Else
'
' MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
'
' Exit Sub
'
' End If
'
' End With

'Current month/year stored in H6 (this is a merged cell)
ThisWorkbook.Sheets("Refund Request Form").Select
RefundNum = Mid(ActiveSheet.Range("F8").Value, InStr(1, ActiveSheet.Range("F8").Value, " ") + 1)

'Create new PDF file name including path and file extension
'PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Range("F8") & " " & ActiveSheet.Range("A11") & ".pdf"
PDFFile = ThisWorkbook.Worksheets("Refund Request Form").Range("A11") & "-" & ThisWorkbook.Worksheets("Refund Request Form").Range("F8") & ".pdf"
Dim PdfFileBackup As String: PdfFileBackup = "Backup-" & PDFFile

On Error Resume Next
'If you want to overwrite the file then delete the current one
Kill ThisWorkbook.Path & Application.PathSeparator & PDFFile
Kill ThisWorkbook.Path & Application.PathSeparator & PdfFileBackup
On Error GoTo 0
' 'If the PDF already exists
' If Len(Dir(PDFFile)) > 0 Then
'
' If AlwaysOverwritePDF = False Then
'
' OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
'
' On Error Resume Next
' 'If you want to overwrite the file then delete the current one
' If OverwritePDF = vbYes Then
'
' Kill PDFFile
'
' Else
'
' MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
' & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
'
' Exit Sub
'
' End If
'
' Else
'
' On Error Resume Next
' Kill PDFFile
'
' End If

' If Err.Number <> 0 Then
'
' MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
' & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
'
' Exit Sub
'
' End If
'
' End If

'Create the PDF
ThisWorkbook.Worksheets("Refund Request Form").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & Application.PathSeparator & PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ThisWorkbook.Worksheets("Refund Log for Print").Visible = True
ThisWorkbook.Worksheets(Array("Refund Log for Print", "Supporting Docs", "IFIS Print Screens")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & Application.PathSeparator & PdfFileBackup, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ThisWorkbook.Worksheets("Supporting Docs").Select
ThisWorkbook.Worksheets("Refund Log for Print").Visible = False

' ThisWorkbook.Worksheets(Array("Refund Request Form", "Refund Log for Print", "Supporting Docs", "IFIS Print Screens")).Select
' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
' :=False, OpenAfterPublish:=OpenPDFAfterCreating

'Create an Outlook object and new mail message
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

'Display email and specify To, Subject, etc
With OutlookMail

.Display
signature = OutlookMail.body
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.Subject = EmailSubject & RefundNum
.Attachments.Add ThisWorkbook.Path & Application.PathSeparator & PDFFile
.Attachments.Add ThisWorkbook.Path & Application.PathSeparator & PdfFileBackup
.body = "Hi," & vbLf & vbLf _
& "The attached Revenue Refund is ready for review." & vbLf & vbLf _
& "The signed copy must be saved to the Shared Drive, overwriting the existing file." & vbLf _
& "F:\40 Elm Documentation\Revenue Sudbury Mailbox\Revenue Refunds." & vbLf & vbLf _
& "Please delete this email from the mailbox once you've completed the request." & vbLf & vbLf _
& "Regards," & vbLf & signature

If DisplayEmail = False Then

.Send

End If

End With

End Sub

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Velouria, Dieneba NDIAYE, Ben Hughes, Dario Serrati, Christopher Anderson, Natasha Smith, dectator mang, Oluwadamilola Ogun, yashal minahil
Guest(s) 9
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 870
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 219
A.Maurizio: 202
Jessica Stewart: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
yashal minahil
Oluwadamilola Ogun
Yannik H
dectator mang
Francis Drouillard
Orlando Inocente
Jovitha Clemence
Maloxat Axmatovna
Ricardo Freitas
Marko Meglic
Forum Stats:
Groups: 3
Forums: 24
Topics: 6200
Posts: 27181

 

Member Stats:
Guest Posters: 49
Members: 31858
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.