Getting the "Do you want to overwrite the file" dialog box to show when saving with VBA - vba

The following code saves a selected area of my excel sheet. If I try to save a file that has the same file name as one that already exists, however, it will just save the file without showing the "Do you want to overwrite the file" dialog box.
Is there a way to change this code so that it will ask if I would like to overwrite the preexisting file?
Option Explicit
Sub CreatePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String
Set wSheet = ActiveSheet
sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If vFile <> "False" Then
wSheet.Range("B2:J44").ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
End Sub

One way to simulate the behavior, as suggested, is to check the selected SaveAsFilename:
Option Explicit
Sub CreatePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String
Set wSheet = ActiveSheet
sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If Dir(vFile) > vbNullString Then _
If MsgBox("Overwrite File?", _
vbExclamation + vbYesNo, "Overwrite?") = vbNo Then Exit Sub
If vFile <> "False" Then
wSheet.Range("B2:J44").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
End Sub

Another alternative:
Replace:
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If vFile <> "False" Then
By:
With Excel.Application.FileDialog(msoFileDialogSaveAs)
Dim i As Integer
For i = 1 To .Filters.Count
If InStr(.Filters(i).Extensions, "pdf") <> 0 Then Exit For
Next i
.FilterIndex = i
.InitialFileName = sFile
.Title = "Select Folder and FileName to save"
'------------------- Bloc A -------------------------
If CBool(.Show) Then
vFile = .SelectedItems.Item(.SelectedItems.Count)
End If
If vFile <> "" Then
'------------------- Bloc A -------------------------
'----------- Or replace "Bloc A" by------------------
'If Not CBool(.Show) Then Exit Sub
'vFile = .SelectedItems.Item(.SelectedItems.Count)
'And remove the "If vFile <> "False" Then" check
'----------------------------------------------------
End With
If you selected an existing file, the overwrite message will show

Related

Generate separate PDF from Sheets in VBA

I am trying to create a macro that will generate separate PDF files for Selected Worksheets in a Workbook. I found this code on line, which works great, it puts all selected sheets in ONE PDF. I need to have each selected sheet as a separate PDF.
I am a beginner to VBA.
Sub PDFActiveSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Separate sheets to separate PDF files
Sub ExportToPDFs()
' PDF Export Macro
' Change C:\Exports\ to your folder path where you need the diles saved
' Save Each Worksheet to a separate PDF file.
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
nm = ws.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\Excel\Desktop\test\" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next ws
End Sub

VBA code to save PDF does not work properly

I have set up a command button to save the current worksheet as a PDF file. I have played around with this code for several hours and almost got it to work properly but it seems I have disconnected some areas and cannot find my way back. Please see below for the code that I am using and the variables I am having an issue with at this point. Any help or information would be much appreciated! Thanks in advance!
Issues:
When you click 'Cancel' in the save application box, the document still tries to save.
If the file already exists:
Selecting 'Yes' to over-write does not save the document.
Selecting 'No' to over-write and renaming as another already existing document does not prompt another Question box to over-write or not. It simply over-writes the original document name.
Sub PDFFHA()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = "I:\OCC FRB REMIC Reporting\Quality Control\PDFs"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Range("D3"), " ", "")
strName = Replace(strName, ".", "_")
strFile = "FHA" & "_" & strName & "_" & "QC" & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
Else
GoTo exitHandler
End If
End If
Else
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
With some clean-up and re-formatting.
If the file already exists, you are prompted to overwrite or not. The code only checks for the response to be vbNo since vbYes implies that strPathFile remains the same, i.e. no action needed. The loop handles a Cancel click, as well as the possibility that your new strPathFile is again an existing file.
Option Explicit
Sub PDF_FHA()
Dim wsA As Worksheet: Set wsA = ActiveWorkbook.ActiveSheet
Dim strName, strPath, strFile, strPathFile As String
On Error GoTo errHandler
' Get path
strPath = "I:\OCC FRB REMIC Reporting\Quality Control\PDFs\"
' Get and clean filename
strName = Replace(wsA.Range("D3"), " ", "")
strName = Replace(strName, ".", "_")
strFile = "FHA_" & strName & "_QC.pdf"
strPathFile = strPath & strFile
' Check if file exists, prompt overwrite
If bFileExists(strPathFile) Then
If MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists") = vbNo Then
Do
strPathFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
' Handle cancel
If strPathFile = "False" Then Exit Sub
' Loop if new filename still exists
Loop While bFileExists(strPathFile)
End If
End If
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
Firstly, turn Option Explicit on.
Follow the logic in If lOver <> vbYes Then. With the proper indenting you will see that it only handles the <> vbYes path and does not have an Else.
So, you do not actually handle the "Yes" case.
Your "No" logic only brings up a file dialog box and we don't know what you have done to test this (cancel, put new name in, just accept name as presented?). However, there is no additional question on this logic path. If you don't hit "Cancel" to the file dialog it will just save the file.

Enabling Save as automatically through vba (Without clicking save on prompt)

How can I get excel to automatically select save through VBA without manually clicking it. E.g- I have Code which selects each value on a Data Validation list and gets me to the stage below, although I have to click save each time.
I have tried adding in:
Application.EnableEvents = True
But it still only takes me to the stage on the image.
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = Cells.Range("B1") & " Period " & Cells.Range("J1")
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=2
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
To avoid prompting:
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = Cells.Range("B1") & " Period " & Cells.Range("J1")
strFile = ThisWorkbook.Path & "\" & strFile & ".PDF"
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=2
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

VBA “Save to PDF” saves even on cancels

I have a problem with a macro. I would like to avoid that the macro saves the PDF file even if I press on Cancel in the Save dialog box. What did I miss?
Here's the code:
Set ws = Foglio5
'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(Foglio5.Cells(14, 2) & "_" & (Foglio5.Cells(14, 4) & "_" & (Foglio5.Cells(15, 10))), "", ""), ".", "_") _
& "_" _
& Format(Foglio5.Cells(17, 5), "yyyymmdd\") _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF Creato! Si trova nella cartella di questo file."
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Errore nella creazione del PDF"
Resume exitHandler
End Sub
I tried changing:
If myFile <> "False" Then
into:
If myFile Then
Now it is not working anymore and it says that it is impossible to save the PDF.
myFile <> "False"
should be
myFile <> False
ref

Saving a Range of data as a PDF with a button in excel

I have code that will bring up a save dialog box when a button in my excel sheet is clicked:
Sub SavePDF()
Dim X
X = Application.GetSaveAsFilename(InitialFileName:=Range("F8") & "_" & Range("F6"), _
FileFilter:="PDF files, *.pdf", _
Title:="Save PDF File")
If TypeName(X) = "Boolean" Then
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=X, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End Sub
...what I need is to add something to this that will only save a certain range of data when the button is clicked. My range is: B2 to J44. At the moment when I click the save button is it saving the whole sheet which I do not want.
Thanks in advance.
Try the following.
Option Explicit
Sub CreatePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String
Set wSheet = ActiveSheet
sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If vFile <> "False" Then
wSheet.Range("B2:J44").ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
End Sub
See Examples here
File is save as SheetName_TodaysDate_HoursMinutes
if you would like to add seconds just add ss next to _hhmmss