完美Excel

在dicks的blog中看到了一段解决同名文件问题的程序解决方案，贴出来共享。
有时，必须存储一个名称与现有文件名相同的文件，此时可以在名称末尾添加数字使其唯一。但问题是该文件将放在三个不同的文件夹中：Working、Review和Archive，需要在这三个文件夹中检查相同的文件名称。
现在，创建一个函数来返回下一个可用的后缀，如果没有相同的文件存在，返回空字符串；如果有相同的文件存在，则返回能够添加到文件名后使其唯一的数字。
该函数遍历文件夹并使用Dir函数来获取相同的名称。为了使用Dir，将搜索的文件更改为包含有星号（*），例如名称为MyFile.xls的成为MyFile*.xls，并且将查找MyFile.xls、MyFile1.xls等等。如果找到匹配项，将分隔数字并记录下最终找到的最大的一个数字。如果没有数字，Replace语句返回一个空字符串并且Val函数将其转换为0。
Function GetUniqueSuffix(sName As String, vaFolders As Variant) As String
    Dim lSuffix As Long, lMax As Long
    Dim sDirName As String
    Dim sBaseName As String
    Dim i As Long
    Dim sTempName As String
    
    Const sEXTENSION As String = “.xls”
    
    sDirName = Replace(sName, sEXTENSION, “*” & sEXTENSION)
    sBaseName = Replace(sName, sEXTENSION, “”)
    
    For i = LBound(vaFolders) To UBound(vaFolders)
        sTempName = Dir(vaFolders(i) & sDirName)
        Do Until Len(sTempName) = 0
            lSuffix = Val(Replace(Replace(sTempName, sBaseName, “”), sEXTENSION, “”)) + 1
            If lSuffix > lMax Then
                lMax = lSuffix
            End If
            sTempName = Dir
        Loop
    Next i
    
    If lMax > 0 Then
        GetUniqueSuffix = CStr(lMax)
    Else
        GetUniqueSuffix = “”
    End If
    
End Function

使用示例:
Sub UniqueSuffixExample()
    
    Dim vaFolders As Variant
    Dim sFile As String
    Dim lUnique As Long
    
    vaFolders = Array(”C:\Working\”, “C:\Review\”, “C:\Archive\”)
    sFile = “MyFile.xls”
    
    lUnique = GetUniqueSuffix(sFile, vaFolders)
    sFile = Replace(sFile, “.xls”, lUnique & “.xls”)
    
    ActiveWorkbook.SaveAs “C:\Working\” & sFile
    
End Sub