Excel VBA Recursive function return not the expected result

Question

I have the following function Which Is calling itself (Recursive). The goal is to return a unique filename formatted as filename (1).ext, filename (2).ext, etc.

Function CreateUniqueFileName(strPath As String, strFileName, orderId As Integer) As String
Dim extPos As Integer
Dim extension As String
Dim fileName As String

fileName = ""

extPos = InStrRev(strFileName, ".")

If (extPos > 0) Then
    fileName = Left(strFileName, extPos - 1)
    extension = Right(strFileName, Len(strFileName) - extPos)

    If (orderId = 0) Then
        fileName = strFileName
        CreateUniqueFileName = fileName
    Else
        fileName = fileName & " (" & CStr(orderId) & ")." & extension
    End If

    If (DoesFileExist(strPath & fileName)) Then
        Call CreateUniqueFileName(strPath, fileName, orderId + 1)
    Else
        CreateUniqueFileName = fileName
        Exit Function
    End If
End If
End Function

If it is called the first time and the orderId value is 0 this is always the first one and therefore unique. So in that case the function is only called once. But when the recursion is executed and the DoesFileExists returns false the return value should return the generated filename and exit. However, when I debug the function is executing without errors but it always returns the original value instead of the result of the original iteration.

So for example, if I call this function like this: CreateUniqueFileName("C:\Temp\",""1010-40-800.jpg",1) It checks in C:\temp if there is already a file named 1010-40-800 (1).jpg, if so the same function is called and the orderId is updated by 1 in this case CreateUniqueFileName("C:\Temp\",""1010-40-800.jpg",2). The same process is repeated (Recusive). Now assume the 1010-40-800 (2).jpg is unique (File is not found). I would expect the function to return 1010-40-800 (2).jpg as as string result. But instead it will return the value 1010-40-800 (1).jpg. Which is actually the value of the first time the function is called.

What am I missing here?

Answer 1

You just have a small flaw in your code when you call your function recursively. Try this

Function CreateUniqueFileName(strPath As String, strFileName, orderId As Integer) As String
    Dim extPos As Integer
    Dim extension As String
    Dim fileName As String

    fileName = ""

    extPos = InStrRev(strFileName, ".")

    If (extPos > 0) Then
        fileName = Left(strFileName, extPos - 1)
        extension = Right(strFileName, Len(strFileName) - extPos)

        If (orderId = 0) Then
            fileName = strFileName
            CreateUniqueFileName = fileName
        Else
            fileName = fileName & " (" & CStr(orderId) & ")." & extension
        End If

        If (DoesFileExist(strPath & fileName)) Then
            CreateUniqueFileName = CreateUniqueFileName(strPath, fileName, orderId + 1)
        Else
            CreateUniqueFileName = fileName
            'Exit Function
        End If
    End If
End Function

This is still not giving you what you want as it appends every orderID but you should see the flaw and hopefully be able to fix the remaining issue.

I used the following function to check if a file exists

Function DoesFileExist(fullFileName As String) As Boolean

    Dim TestStr As String
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(fullFileName)
    On Error GoTo 0
    If TestStr = "" Then
        DoesFileExist = False
    Else
        DoesFileExist = True
    End If

End Function

But in this case IMO a loop would be better for getting a unique file name.

Update: Find attached the completely fixed version for the recursive call and a "loop" version

 Function CreateUniqueFileName(strPath As String, strFileName, orderID As Integer) As String
    Dim extPos As Integer
    Dim extension As String
    Dim fileName As String
    Dim resFilename As String

    extPos = InStrRev(strFileName, ".")

    If (extPos > 0) Then
        fileName = Left(strFileName, extPos - 1)
        extension = Right(strFileName, Len(strFileName) - extPos)

        If (orderID = 0) Then
            resFilename = strFileName
        Else
            resFilename = fileName & " (" & CStr(orderID) & ")." & extension
        End If

        If (DoesFileExist(strPath & resFilename)) Then
            CreateUniqueFileName = CreateUniqueFileName(strPath, strFileName, orderID + 1)
        Else
            CreateUniqueFileName = resFilename
        End If

    End If
End Function

And the version with a loop

Function CreateUniqueFileNameA(strPath As String, strFileName) As String

    Dim extPos As Integer
    Dim extension As String
    Dim fileName As String
    Dim resFilename As String
    Dim orderID As Long

    extPos = InStrRev(strFileName, ".")

    If extPos > 0 Then

        fileName = Left(strFileName, extPos - 1)
        extension = Right(strFileName, Len(strFileName) - extPos)
        orderID = 0

        resFilename = strFileName
        Do While DoesFileExist(strPath & resFilename)
            orderID = orderID + 1
            resFilename = fileName & " (" & CStr(orderID) & ")." & extension
        Loop

    End If

    CreateUniqueFileNameA = resFilename

End Function