• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Save Sheet as PDF With File Name Check

tim220225

New Member
Hello all. How can I amend the below code to check for a duplicate file in the save folder and prompt me to overwrite the file or to change the name? Should the file name being created not exist the code just needs to continue running as it does now.

Thanks in advance.

Tim

>>> use code - tags <<<
Code:
Sub SaveAsPDF()
'Saves active worksheet as pdf using concatenation
'of A1,A2,A3

Dim fName As String
With ActiveSheet
    fName = .Range("A1").Value & .Range("A2").Value & .Range("A3").Value
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\My Documents\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End Sub
 
Last edited by a moderator:
tim220225
One sample for You ... based Your code.
Code:
Sub SaveAsPDF()
'Saves active worksheet as pdf using concatenation
'of A1,A2,A3
Dim fName As String
    With ActiveSheet
        fName = "C:\My Documents\" & .Range("A1").Value & .Range("A2").Value & .Range("A3").Value
        If Dir(fName) <> Empty Then
            If MsgBox("No = Overwrite the file" & vbCr & "Yes = Change the name", vbYesNo, fName) = vbYes Then
                MsgBox "Change the name and try again!", vbOKOnly, "Next"
                Exit Sub
            End If
        End If
        .ExportAsFixedFormat Type:=xlTypePDF, FileName:= fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub
 
Last edited:
Thanks for the response. I installed your code changes and everything runs as expected except that I can't get the message box to change file name to come up when a file name exists in the folder. What am I missing here?


tim220225
One sample for You ... based Your code.
Code:
Sub SaveAsPDF()
'Saves active worksheet as pdf using concatenation
'of A1,A2,A3
Dim fName As String
    With ActiveSheet
        fName = "C:\My Documents\" & .Range("A1").Value & .Range("A2").Value & .Range("A3").Value
        If Dir(fName) <> Empty Then
            If MsgBox("No = Overwrite the file" & vbCr & "Yes = Change the name", vbYesNo, fName) = vbYes Then
                MsgBox "Change the name and try again!", vbOKOnly, "Next"
                Exit Sub
            End If
        End If
        .ExportAsFixedFormat Type:=xlTypePDF, FileName:= fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub
 
tim220225
... prompt me ... to change the name?
Didn't You ask prompt You?
... isn't it different that eg enable to change the name?
Did You get a message which prompts You ... "Change the name and try again!"?
 
Yes, I would need the code to prompt me that the file name already exists and give me the opportunity to change it then save it. I get no message box at all. Each time I run the code it creates a PDF of the sheet and saves it to the folder My documents. As a test I immediately run the code again and it automatically saves and overwrites the existing PDF in the destination folder.

tim220225
... prompt me ... to change the name?
Didn't You ask prompt You?
... isn't it different that eg enable to change the name?
Did You get a message which prompts You ... "Change the name and try again!"?
 
tim220225
Seems You have changed Your wants.
That 'missing message' was because, Your A3-value wasn't .pdf.
... and it would ask to modify Your file name ... try again ... There were none hint before, how would You do it?
With this, Your given the file name not include .pdf nor the file path at all!
The file path is fixed as You've given.
The file name is as You've given or modified.
There could be some challenges with Your A1, A2 & A3-values.

Code:
Sub SaveAsPDF()
    On Error Resume Next
    With ActiveSheet
        fPath = "C:\My Documents\"
        fName = .Range("A1").Value & .Range("A2").Value & .Range("A3").Value
        If Dir(fPath & fName & ".pdf") <> Empty Then
            fOK = False
            Do
                If MsgBox("No = Overwrite the file" & vbCr & "Yes = Change the name", vbYesNo, fPath & fName & ".pdf") = vbYes Then
                    fName = InputBox("Name Of File (without extension)", "New Valid Name Of File", fName)
                Else
                    fOK = True
                End If
            Loop Until Dir(fPath & fName & ".pdf") = Empty Or fOK
        End If
        .ExportAsFixedFormat Type:=xlTypePDF, FileName:=fPath & fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, fPath & fName & ".pdf"
    End With
End Sub
 
Back
Top