Excel VBA 递归函数 return 不是预期的结果

Question

我有以下函数正在调用自身（递归）。目标是 return 一个唯一的文件名，格式为文件名 (1).ext、文件名 (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 returns 为 false 时，return 值应该 return 生成的文件名并退出。但是，当我调试该函数时，该函数正在无误地执行，但它总是 returns 原始值而不是原始迭代的结果。

例如，如果我这样调用这个函数：CreateUniqueFileName("C:\Temp\",""1010-40-800.jpg",1) 它会在 C:\temp 中检查是否已经存在名为 1010-40-800 (1).jpg 的文件，如果存在则调用相同的函数并将 orderId 更新为 1 in这种情况下 CreateUniqueFileName("C:\Temp\",""1010-40-800.jpg",2)。重复相同的过程（递归）。现在假设 1010-40-800 (2 ).jpg 是唯一的（找不到文件）。我希望函数 return 1010-40-800 (2).jpg 作为字符串结果。但它会 return 值 1010-40-800 (1).jpg。这实际上是第一次调用函数时的值。

我在这里错过了什么？

Answer 1

当您递归调用您的函数时，您的代码中有一个小缺陷。试试这个

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

这仍然没有给你想要的东西，因为它附加了每个 orderID，但你应该看到这个缺陷并希望能够解决剩下的问题。

我使用了以下函数来检查文件是否存在

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

Answer 2

您的代码存在结构、逻辑和假设问题。

结构问题是用于拆分扩展名的代码包含您的递归调用，因此如果文件名不包含扩展名，您的递归将永远不会发生。如果这是一个深思熟虑的决定，那么最好早点退出函数，而不是在 if end if 中包含其他所有内容。

你的逻辑错误是你没有正确使用函数的递归调用

Call CreateUniqueFileName(strPath, fileName, orderId + 1)

应该是

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

您的假设问题是函数的参数是值。他们不是。默认情况下 VBA 通过引用传递参数，因此在您的代码中 'filename' 每次调用函数时都是相同的变量而不是新副本。

因此这一行

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

请注意，我没有运行上面的代码，但它编译得很好。

Excel VBA 递归函数 return 不是预期的结果

Excel VBA Recursive function return not the expected result

excel

recursion

vba

filesystemobject