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

Question

我有以下调用自身（递归）的函数。目标是返回一个唯一的文件名，格式为文件名 (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 返回 false 时，返回值应该返回生成的文件名并退出。但是，当我调试该函数时，该函数执行没有错误，但它始终返回原始值而不是原始迭代的结果。

例如，如果我这样调用这个函数： CreateUniqueFileName("C:\Temp\",""1010-40-800.jpg",1) 如果已经有一个名为 1010-40-800 (1).jpg 的文件，它会检查 C:\temp，如果是，则调用相同的函数并且 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。其实是函数第一次调用的值。

我在这里错过了什么？

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 循环会更好地获取唯一的文件名。

更新：找到附加的递归调用的完全固定版本和“循环”版本

 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 结束 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

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