Hello team
I have code that works well to take a spreadsheet, export to a PDF, however it prompts for a folder first and then creates the file name from a combination of data in a cell and code in the string. In the middle of all that, it will see if the file already exists and ask to overwrite it or not.
What Im trying to do now is all the same but end up with a .XLS file, not a PDF. Not a pro-coder but with the great help of places like this I get what I need, but in this case after days of trying I fail! Advice would be very much appreciated. Here's the code I have to start with:
[SIZE=9px]Sub Quote()
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
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
CurrentMonth = ""
' Note: lock date
Sheets("Sheet1").Select
Range("a3").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("a3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("sheet1").Select
'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)
MsgBox "Specify a folder to save this Proposal", vbInformation, "Specify Destination Folder"
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)
'CurrentMonth = Mid(ActiveSheet.Range("k5").Value, InStr(1, ActiveSheet.Range("k5").Value, " ") + 1)
'Create new PDF file name including path and file extension
'PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& "_" & CurrentMonth & ".pdf"
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Range("b7").Value _
& "_" & Format(Date, "yyyymmdd") & ".pdf"
'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.", 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
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End Sub[/SIZE]