If file already exist in a designated path, add a index # counter in the file name

[Piaba]

Good morning everyone,

I'd like to make my code to check if a file with same name is in the folder already, if so, make it to save with a different number index starting with 1. Here is the code that I'm using now:

Sub TestFile

Dim FilePathandName As String

Set fs = CreateObject("scripting.filesystemobject")

FilePathandName = Application.ActiveWorkbook.FullName

Set file = fs.CreateTextFile(Mid(FilePathandName, 1, InStrRev(FilePathandName, ".") - 1) & ".kml", True, True)

End Sub

Can anybody please help me?

 

[shknbk2]

Here's something I came up with. Might not be as efficient as possible, but it's a start. If you have a Test.kml file, it will create a Test1.kml file, etc.

I didn't touch the "Set file" part of the code because I'm not sure what you are doing there. It seems like you are just creating a blank file so far, which might be your intention. If you need more, your code will have to spell it out.

Sub TestFile()

Dim FilePathandName As String
Dim fs As FileSystemObject

Set fs = CreateObject("scripting.filesystemobject")

FilePathandName = GetFilename(Application.ActiveWorkbook.FullName)

Set file = fs.CreateTextFile(FilePathandName, True, True)

End Sub

Function GetFilename(fName As String) As String
    Dim i As Integer
    Dim sPath As String
    Dim sName As String
    Dim sFile As String
    
    sPath = Mid(fName, 1, InStrRev(fName, "\"))
    sName = Mid(fName, InStrRev(fName, "\") + 1)
    sName = Mid(sName, 1, InStrRev(sName, ".") - 1)
    sFile = Dir(sPath & sName & ".kml")
    Do While sFile <> ""
        i = i + 1
        sFile = Dir(sPath & sName & i & ".kml")
    Loop
    GetFilename = sPath & sName & i & ".kml"
End Function

 

[johnnyL]

@Piaba I think you are missing a loop in there but the following should work once you include the rest of your code:

Dim i As Long

Sub TestFile()
'
    Dim FSO             As Object
    Dim FilePathandName As String
'
    Set FSO = CreateObject("scripting.filesystemobject")
'
    FilePathandName = GetNextAvailableFileName(Mid(Application.ActiveWorkbook.FullName, 1, InStr(1, Application.ActiveWorkbook.FullName, ".") - 1) & ".klm")
'
    Set file = FSO.CreateTextFile(FilePathandName, True, True)
'
End Sub

Function GetNextAvailableFileName(ByVal strPath As String) As String
'
    Dim FSO         As Object
    Dim strFolder   As String
    Dim strBaseName As String
    Dim strExt      As String
'
    With CreateObject("Scripting.FileSystemObject")
        strFolder = .GetParentFolderName(strPath)
        strBaseName = .GetBaseName(strPath)
        strExt = .GetExtensionName(strPath)
'
        Do While .FileExists(strPath)
            i = i + 1
            strPath = .BuildPath(strFolder, strBaseName & "-" & i & "." & strExt)
        Loop
    End With
'
    GetNextAvailableFileName = strPath
End Function

 

[Piaba]

Good morning,

Tried you guys codes and both worked for the macro that I wanted to create. Thanks so much.