none
How to check if a PDF file already exists and save a copy if it already does? RRS feed

  • Question

  • Hi,

    I've been trying to save excel as PDF, check if a PDF file already exists and save a copy if it already does. But it keeps overwriting the file.

    The codes are as followed.

    Sub doesFileExist()
    Dim MyFile As String
    MyFile = "C:\Users\sand\Desktop\PDF\FileName"

    If Dir(MyFile) <> "" Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\sand\Desktop\PDF\COPY OF" & Range("E9").Value
        MsgBox "The file already exists! A copy has been saved.", vbInformation, "Info"
        Cancel = True
        
    Else
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\sand\Desktop\PDF\" & Range("E9").Value
        MsgBox "Checklist has been submitted successfully!", vbInformation, "Info"

    End If
    End Sub

    Friday, February 23, 2018 2:49 AM

Answers

  • It might be better if you used the following approach, which will not overwrite the file if it exists no matter how many times you save it and instead will append a number to the filename. It also checks that E9 doesn't contain any illegal filename characters. If you are sure that will never be the case you can remove that check.

    Option Explicit

    Sub SaveSheetAsPDF()
    Dim strName As String
    Const strPath As String = "C:\Users\sand\Desktop\PDF\"
        strName = Range("E9").value & ".pdf"
        strName = CleanFileName(strName, ".pdf")
        strName = FileNameUnique(strPath, strName, ".pdf")
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=strPath & strName
    End Sub

    Private Function FileNameUnique(strPath As String, _
                                   strFilename As String, _
                                   strExtension As String) As String
    'Graham Mayor
    'Requires the use of the FileExists function
    'strPath is the path in which the file is to be saved
    'strFilename is the filename to check
    'strextension is the extension of the filename to check
    Dim lngF As Long
    Dim lngName As Long
        strExtension = Replace(strExtension, Chr(46), "")
        lngF = 1
        lngName = Len(strFilename) - (Len(strExtension) + 1)
        strFilename = Left(strFilename, lngName)
        'If the filename exists, add or increment a number to the filename
        'and keep checking until a unique name is found
        Do While FileExists(strPath & strFilename & Chr(46) & strExtension) = True
            strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
            lngF = lngF + 1
        Loop
        'Reassemble the filename
        FileNameUnique = strFilename & Chr(46) & strExtension
    lbl_Exit:
        Exit Function
    End Function

    Private Function FileExists(strFullName As String) As Boolean
    'Graham Mayor
    'strFullName is the name with path of the file to check
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(strFullName) Then
            FileExists = True
        Else
            FileExists = False
        End If
    lbl_Exit:
        Set fso = Nothing
        Exit Function
    End Function

    Private Function CleanFileName(strFilename As String, strExtension As String) As String
    'Graham Mayor
    'A function to ensure there are no illegal filename
    'characters in a string to be used as a filename
    'strFilename is the filename to check
    'strExtension is the extension of the file
    Dim arrInvalid() As String
    Dim vfName As Variant
    Dim lng_Name As Long
    Dim lng_Ext As Long
    Dim lngIndex As Long
        'Ensure there is no period included with the extension
        strExtension = Replace(strExtension, Chr(46), "")
        'Record the length of the extension
        lng_Ext = Len(strExtension)

        'Remove the path from the filename if present
        If InStr(1, strFilename, Chr(92)) > 0 Then
            vfName = Split(strFilename, Chr(92))
            CleanFileName = vfName(UBound(vfName))
        Else
            CleanFileName = strFilename
        End If

        'Remove the extension from the filename if present
        If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
            CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
        End If

        'Define illegal characters (by ASCII CharNum)
        arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
        'Add the extension to the filename
        CleanFileName = CleanFileName & Chr(46) & strExtension
        'Remove any illegal filename characters
        For lngIndex = 0 To UBound(arrInvalid)
            CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
        Next lngIndex
    lbl_Exit:
        Exit Function
    End Function


    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by sandnspace Wednesday, February 28, 2018 12:41 AM
    Friday, February 23, 2018 5:46 AM

All replies

  • It might be better if you used the following approach, which will not overwrite the file if it exists no matter how many times you save it and instead will append a number to the filename. It also checks that E9 doesn't contain any illegal filename characters. If you are sure that will never be the case you can remove that check.

    Option Explicit

    Sub SaveSheetAsPDF()
    Dim strName As String
    Const strPath As String = "C:\Users\sand\Desktop\PDF\"
        strName = Range("E9").value & ".pdf"
        strName = CleanFileName(strName, ".pdf")
        strName = FileNameUnique(strPath, strName, ".pdf")
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=strPath & strName
    End Sub

    Private Function FileNameUnique(strPath As String, _
                                   strFilename As String, _
                                   strExtension As String) As String
    'Graham Mayor
    'Requires the use of the FileExists function
    'strPath is the path in which the file is to be saved
    'strFilename is the filename to check
    'strextension is the extension of the filename to check
    Dim lngF As Long
    Dim lngName As Long
        strExtension = Replace(strExtension, Chr(46), "")
        lngF = 1
        lngName = Len(strFilename) - (Len(strExtension) + 1)
        strFilename = Left(strFilename, lngName)
        'If the filename exists, add or increment a number to the filename
        'and keep checking until a unique name is found
        Do While FileExists(strPath & strFilename & Chr(46) & strExtension) = True
            strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
            lngF = lngF + 1
        Loop
        'Reassemble the filename
        FileNameUnique = strFilename & Chr(46) & strExtension
    lbl_Exit:
        Exit Function
    End Function

    Private Function FileExists(strFullName As String) As Boolean
    'Graham Mayor
    'strFullName is the name with path of the file to check
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(strFullName) Then
            FileExists = True
        Else
            FileExists = False
        End If
    lbl_Exit:
        Set fso = Nothing
        Exit Function
    End Function

    Private Function CleanFileName(strFilename As String, strExtension As String) As String
    'Graham Mayor
    'A function to ensure there are no illegal filename
    'characters in a string to be used as a filename
    'strFilename is the filename to check
    'strExtension is the extension of the file
    Dim arrInvalid() As String
    Dim vfName As Variant
    Dim lng_Name As Long
    Dim lng_Ext As Long
    Dim lngIndex As Long
        'Ensure there is no period included with the extension
        strExtension = Replace(strExtension, Chr(46), "")
        'Record the length of the extension
        lng_Ext = Len(strExtension)

        'Remove the path from the filename if present
        If InStr(1, strFilename, Chr(92)) > 0 Then
            vfName = Split(strFilename, Chr(92))
            CleanFileName = vfName(UBound(vfName))
        Else
            CleanFileName = strFilename
        End If

        'Remove the extension from the filename if present
        If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
            CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
        End If

        'Define illegal characters (by ASCII CharNum)
        arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
        'Add the extension to the filename
        CleanFileName = CleanFileName & Chr(46) & strExtension
        'Remove any illegal filename characters
        For lngIndex = 0 To UBound(arrInvalid)
            CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
        Next lngIndex
    lbl_Exit:
        Exit Function
    End Function


    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by sandnspace Wednesday, February 28, 2018 12:41 AM
    Friday, February 23, 2018 5:46 AM
  • Hi,

    In advance, sorry if I misunderstand your code (what you want to do).

    So, I would like to confirm:
    (1) MyFile = "C:\Users\sand\Desktop\PDF\FileName"
       Doesn't your file have a file extension like ".pdf"?
    (2) Please provide the value in cell E9.

    Regards,

    Ashidacchi

    Friday, February 23, 2018 6:03 AM
  • Hi,

    (1) Yes, my file already has file extension .pdf which I used the following code to save file as.

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:/Users/sand/Desktop/PDF/" & Range("E9").Value, OpenAfterPublish:=True

    (2) Value in cell E9 can be any file name, e.g. Micro.

    Tuesday, February 27, 2018 1:55 AM
  • Hi,

    It works very well with slight adjustment according to what I want. Thank you so much.

    Tuesday, February 27, 2018 2:13 AM