Microsoft Office Forums - View Single Post

gmayor · 09-13-2014, 12:28 AM

An alternative would be to ensure that an existing file is never overwritten by appending a number to the filename. The following two functions will between them perform both operations.

Code:

Public Function FileNameUnique(strPath As String, _
                               strFilename As String, _
                               strExtension As String) As String
Dim lngF As Long
Dim lngName As Long
    lngF = 1
    lngName = Len(strFilename) - (Len(strExtension) + 1)
    strFilename = Left(strFilename, lngName)
    Do While FileExists(strPath & strFilename & Chr(46) & strExtension) = True
        strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    FileNameUnique = strFilename & Chr(46) & strExtension
lbl_Exit:
    Exit Function
End Function


Public Function FileExists(ByVal Filename As String) As Boolean
Dim lngAttr As Long
    On Error GoTo NoFile
    lngAttr = GetAttr(Filename)
    If (lngAttr And vbDirectory) <> vbDirectory Then
        FileExists = True
    End If
NoFile:
    Exit Function
End Function