Рекурсивная функция Excel VBA возвращает не ожидаемый результат

У вас просто есть небольшая ошибка в вашем коде, когда вы вызываете свою функцию рекурсивно. Попробуй это

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

Это по-прежнему не дает вам того, что вы хотите, поскольку он добавляет каждый идентификатор заказа, но вы должны увидеть недостаток и, надеюсь, сможете исправить оставшуюся проблему.

Я использовал следующую функцию, чтобы проверить, существует ли файл

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

Но в этом случае IMO цикл будет лучше для получения уникального имени файла.

Обновление: найдите прикрепленную полностью исправленную версию для рекурсивного вызова и версию "цикла".

 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

И вариант с петлей

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

В вашем коде есть структурные, логические и предположительные проблемы.

Проблема структуры заключается в том, что код для разделения расширения включает ваш вызов рекурсии, поэтому ваша рекурсия никогда не произойдет, если имя файла не содержит расширения. Если это осознанное решение, то лучше выйти из функции раньше, чем заключать все остальное в if end if.

Ваша логическая ошибка в том, что вы неправильно используете рекурсивный вызов функции.

Call CreateUniqueFileName(strPath, fileName, orderId + 1)

Должно быть

CreateUniqueFileName = CreateUniqueFileName(strPath, fileName, orderId + 1)

Проблема вашего предположения заключается в том, что аргументы вашей функции являются значениями. Они не. По умолчанию VBA передает параметры по ссылке, поэтому в вашем коде имя файла - это одна и та же переменная каждый раз, когда вызывается функция, а не новая копия.

Следовательно, эта строка

fileName = fileName & " (" & CStr(orderId) & ")." & extension

просто вызовет проблемы с именем файла, поскольку вы выполняете рекурсию с именем файла, а не с strFilename.

Я реструктурировал ваш код, чтобы сделать рекурсивную часть более чистой (хотя, по наблюдениям других, цикл был бы намного предпочтительнее)

Function CreateUniqueFileName(ByVal StrPath As String, ByVal strFileName, ByRef orderId As Integer) As String

Dim FileNameArray                                As Variant

    FileNameArray = Split(strFileName, ".")

    If Len(FileNameArray(1)) = 0 Then

        Debug.Print ("CreateUniqueFilename says strFilename has no extension")
        CreateUniqueFileName = vbNullString
        Exit Function

    End If

    If orderId = 0 Then

       CreateUniqueFileName = FileNameArray(0) & Format(orderId, "0000") & FileNameArray(1)
       Exit Function

    End If

    CreateUniqueFileName = GetUniqueName(StrPath, FileNameArray, orderId)

End Function


Public Function GetUniqueName(ByRef StrPath As String, ByRef FileNameArray As Variant, ByVal orderId As Integer) As String
' StrPath and FIlenamearray are passed by reference as they don't change during the recursion
' orderid is passed by value so that we don't change the value of orderid in the calling code.
' If this side effect is desired, change the ByVal to ByRef

Dim myFilename                                     As String

    myFilename = FileNameArray(0) & Format(orderId, "0000") & FileNameArray(1)

    If (DoesFileExist(StrPath & myFilename)) Then

        GetUniqueName = GetUniqueName(StrPath, FileNameArray, orderId + 1)

    Else

        GetUniqueName = myFilename

    End If

End Function

Обратите внимание, что я не запускал приведенный выше код, но он отлично компилируется.