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

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

0 голосов
/ 03 ноября 2019

У меня есть следующая функция, которая вызывает себя (рекурсивно). Цель состоит в том, чтобы вернуть уникальное имя файла, отформатированное как filename (1) .ext, filename (2) .ext и т. Д. 

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

Если оно вызывается в первый раз и значение orderId равно 0, этовсегда первый и поэтому уникальный. Так что в этом случае функция вызывается только один раз. Но когда рекурсия выполняется, а DoesFileExists возвращает false, возвращаемое значение должно вернуть сгенерированное имя файла и выйти. Однако при отладке функция выполняется без ошибок, но всегда возвращает исходное значение, а не результат исходной итерации.

Так, например, если я вызываю эту функцию следующим образом: CreateUniqueFileName ("C: \ Temp \", "" 1010-40-800.jpg ", 1) Она проверяет C: \temp , если уже существует файл с именем 1010-40-800 (1) .jpg, если так, то вызывается та же функция, и orderId обновляется на 1, в этом случае CreateUniqueFileName ("C: \ Temp \", ""1010-40-800.jpg", 2). Тот же процесс повторяется (Recusive). Теперь предположим, что 1010-40-800 (2) .jpg уникален (файл не найден). Я ожидаю, что функция вернет 1010-40-800 (2) .jpg как строковый результат. Но вместо этого он вернет значение 1010-40-800 (1) .jpg . Что на самом деле является значением первого вызова функции.

Что мне здесь не хватает?

Ответы [ 2 ]

1 голос
/ 03 ноября 2019

Существуют структурные, логические и предполагаемые проблемы с вашим кодом.

Проблема структуры заключается в том, что код для разделения расширения охватывает ваш рекурсивный вызов, поэтому ваша рекурсия никогда не произойдет, если имя файла не содержитрасширение. Если это преднамеренное решение, то лучше выйти из функции раньше, чем охватывать все остальное в конце 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

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

1 голос
/ 03 ноября 2019

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

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 будет лучше для получения уникального имени файла цикл.

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

 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
...