vba - 如果目录中已存在该文件，请使用不同的名称保存

Question

我不知道这段代码哪里错了。

If Dir(FILE_PATH & personList(i, 1) & FILE_EXT) <> "" Then
    .SaveAs2 FILE_PATH & "1" & personList(i, 1) & FILE_EXT
    .Close
Else
    .SaveAs2 FILE_PATH & personList(i, 1) & FILE_EXT
    .Close
End If

一切正常，但是当我在列中遇到相同的值(例如:John Doe，John Doe)时，程序会覆盖第一个 John Doe 文件。

Answer 1

这是一个可用于检索任何给定路径的唯一文件名的函数。它将在文件名后添加 "- n" 后缀，其中 n 是一个连续的数字。

Function GetNextAvailableName(ByVal strPath As String) As String

    With CreateObject("Scripting.FileSystemObject")

        Dim strFolder As String, strBaseName As String, strExt As String, i As Long
        strFolder   = .GetParentFolderName(strPath)
        strBaseName = .GetBaseName(strPath)
        strExt      = .GetExtensionName(strPath)

        Do While .FileExists(strPath)
            i = i + 1
            strPath = .BuildPath(strFolder, strBaseName & " - " & i & "." & strExt)
        Loop

    End With

    GetNextAvailableName = strPath

End Function

假设文件c:\path\to\file.ext存在，则调用以下内容:

Debug.Print GetNextAvailableName("c:\path\to\file.ext")

将打印:

c:\path\to\file - 1.ext