Log In
Register
Home
New Member
February 14, 2021
Offline
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!!
November 8, 2013
Offline
Hi Janah,
In Module2 you have code that can be easily modified to what you need:
This section:
' 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:
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
New Member
February 14, 2021
Offline
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
November 8, 2013
Offline
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
1 Guest(s)
