3

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
USFBS
  • 279
  • 3
  • 12
tom bannister
  • 131
  • 3
  • 14
  • You could use `Dir()` to check for the existence of the file and then pop up your own message with `MsgBox`. – Rory Jun 29 '15 at 11:42

2 Answers2

4

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
paul bica
  • 10,557
  • 4
  • 23
  • 42
  • This method works and it does what I want it to do but now if I cancel the save the code errors out – tom bannister Jun 29 '15 at 14:09
  • Can you provide any error details, and the line of code where the errors is (it will take you to the line when you click the Debug button) – paul bica Jun 29 '15 at 14:20
  • The error that is returned is: "Run-time error '5': Invalid procedure call or argument When I click debug, the line that is highlighted is: vFile = .SelectedItems.Item(.SelectedItems.Count) – tom bannister Jun 29 '15 at 14:24
  • In the code provided by @simpLE MAn (in Block A) replace the line `vFile = .SelectedItems.Item(.SelectedItems.Count)` with this line `If .SelectedItems.Count > 0 Then vFile = .SelectedItems.Item(.SelectedItems.Count)` – paul bica Jun 29 '15 at 14:45
  • @tombannister; The line `If CBool(.Show) Then` is supposed to catch that error (when you click "Cancel". Please take a look at the edit. – simpLE MAn Jun 29 '15 at 14:57
  • That's the winner! Thank you! :) – tom bannister Jun 29 '15 at 14:58
3

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

simpLE MAn
  • 1,582
  • 13
  • 22
  • This method works and it does what I want it to do but now if I cancel the save the code errors out – tom bannister Jun 29 '15 at 14:08
  • This way is good but paul bica has provided another answer that gets the usual save as dialog box that you would normally see. Thank you for your help – tom bannister Jun 29 '15 at 15:00
  • @tombannister; I'm sorry but my code shows the exact popup that would be usually shown by windows. I think you mixed the answers since you asked about lines from my answer in Paul Bica's comments. But it's alright with me if his answer suits you best. Thanks for the upvote. – simpLE MAn Jun 29 '15 at 15:12
  • 1
    Superb answer! I love that I can use Excel's "overwrite" mechanism, rather than inventing my own. – Tamara Aviv May 10 '17 at 18:07
  • This is a great answer. The only downside to this method is that you can't restrict the file filters to a specific file type (ie pdf). There are some inelegant workarounds (ie change the file extension afterwards). Despite whats written in the office help you cannot clear the filters for this type of dialog. – marcp Jul 31 '18 at 22:16