Vba 如果目录中已存在文件，请使用其他名称保存

我不知道这个代码哪里错了

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

如果Dir（文件路径和个人列表（i，1）和文件外部）“，则
.SaveAs2文件\路径和“1”&个人列表（i，1）&文件\外部
.结束
其他的
.SaveAs2文件\路径和个人列表（i，1）和文件\外部
.结束
如果结束

---

一切正常，但当我在列中遇到相同的值时（例如：John Doe，John Doe），程序将覆盖第一个John Doe文件。

以下是创建唯一文件路径的函数：

If FileLen(FILE_PATH & personList(i, 1) & FILE_EXT) > 0 Then
    '// File Exists, change name accordingly.
Else
    '// File doesn't exist, save as is.
End If

为了使下面的代码正常工作，必须将其粘贴到代码中

如果作为参数提供的文件路径已经存在，函数返回相同的文件路径，并在括号中添加数字，即如果文件“C:\file.xlsx”已经存在，函数返回“C:\file（1）.xlsx”

如果此文件不存在，函数将返回原始文件路径而不进行任何更改

将问题中粘贴的所有代码替换为以下代码：

Dim filepath As String

filepath = uniqueFilePath(FILE_PATH & personList(i, 1) & FILE_EXT)
Call .SaveAs(filepath)
Call .Close

---

我使用非常类似的方法来更新文档。看看你能不能根据自己的需要改变一下

Rechecker:
Filename = Sheets("Word_Front").Range("N142").Value
If Not (Update_Only) Then
    If Dir(sDocPath & Filename & Cert & ".docx") <> "" Then
        iret = MsgBox("Existing file found with this filename, Answer YES to up-issue the file. Please note there is no further warning and NO to overwrite the file.", vbYesNo)
        If iret = 6 Then
            Sheets("Word_Front").Range("Q7").Value = Sheets("Word_Front").Range("Q7").Value + 1
            GoTo Rechecker
        Else
            oDoc.SaveAs sDocPath & Filename & Cert & ".docx", 16
        End If
    Else
        oDoc.SaveAs sDocPath & Filename & Cert & ".docx", 16
    End If
End If

重新检查：
文件名=工作表（“Word_Front”）.范围（“N142”）.值
如果没有（仅更新_），则
如果Dir（sDocPath&Filename&Cert&“.docx”）”，那么
iret=MsgBox（“找到具有此文件名的现有文件，请回答“是”以更新该文件。请注意，没有进一步的警告，也没有覆盖该文件的警告。”，vbYesNo）
如果iret=6，则
图纸（“文字正面”）。范围（“Q7”）。值=图纸（“文字正面”）。范围（“Q7”）。值+1
去复检
其他的
oDoc.SaveAs sDocPath和文件名以及证书和“.docx”，16
如果结束
其他的
oDoc.SaveAs sDocPath和文件名以及证书和“.docx”，16
如果结束
如果结束

这个函数我已经使用了很长一段时间了，但我不确定是从哪里得到的。如果文件名没有扩展名，或者有100多个文件具有相同的基本名称，则会暂停：

Sub test()

    Debug.Print GenerateUniqueName("S:\Bartrup-CookD\New Folder\Book1.xlsm")

End Sub

'----------------------------------------------------------------------
' GenerateUniqueName
'
'   Generates a file name that doesn't exist by appending a number
'   in between the base name and the extension.
'   Example: GenerateUniqueName("c:\folder\file.ext") = "c:\folder\file4.ext"
'----------------------------------------------------------------------
Function GenerateUniqueName(FullFileName As String, Optional fAlwaysAddNumber As Boolean) As String

    Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")

    If Not objFSO.FileExists(FullFileName) And Not fAlwaysAddNumber Then
        GenerateUniqueName = FullFileName
    Else
        Dim strExt As String
        Dim strNonExt As String
        Dim strNewName As String
        Dim i As Integer
        strExt = objFSO.GetExtensionName(FullFileName)
        Debug.Assert strExt <> ""
        strNonExt = objFSO.BuildPath(objFSO.GetParentFolderName(FullFileName), objFSO.GetBaseName(FullFileName))
        Do
            Debug.Assert i < 100
            i = i + 1
            strNewName = strNonExt & i & "." & strExt

        Loop While objFSO.FileExists(strNewName)
        GenerateUniqueName = strNewName
    End If
End Function

子测试（）
Debug.Print GenerateUniqueName（“S:\Bartrup CookD\New Folder\Book1.xlsm”）
端接头
'----------------------------------------------------------------------
“GenerateUniqueName
'
'通过追加数字生成不存在的文件名
'位于基名称和扩展名之间。
'示例：GenerateUniqueName（“c:\folder\file.ext”）=“c:\folder\file4.ext”
'----------------------------------------------------------------------
函数GenerateUniqueName（FullFileName为字符串，可选fallwaysaddNumber为布尔值）为字符串
Dim objFSO As Object:Set objFSO=CreateObject（“Scripting.FileSystemObject”）
如果不存在objFSO.FileExists（FullFileName）且不存在fallwaysaddnumber，则
GenerateUniqueName=FullFileName
其他的
像弦一样的暗线
将strNonExt设置为字符串
作为字符串的Dim strNewName
作为整数的Dim i
strExt=objFSO.GetExtensionName（FullFileName）
调试。断言strExt“”
strNonExt=objFSO.BuildPath（objFSO.GetParentFolderName（FullFileName），objFSO.GetBaseName（FullFileName））
做
Debug.Assert i<100
i=i+1
strNewName=strNonExt&i&“&strExt
objFSO.FileExists时循环（strNewName）
GenerateUniqueName=strNewName
如果结束
端函数

这里有一个函数，您可以使用它来检索任何给定路径的唯一文件名。它将在文件名后面加一个

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

---

对于一个看似简单的问题，其中很多都是很长的答案。大多数引用文件系统对象；我注意到你没有提到

我的解决方案是使用

WHILE

而不是

IF

While Dir(FILE_PATH & personList(i, 1) & FILE_EXT) <> ""
    i = i + 1
Wend
.SaveAs2 FILE_PATH & i & "1" & personList(i, 1) & FILE_EXT
.Close

While Dir（文件路径和个人列表（i，1）和文件外部）”
i=i+1
温德
.SaveAs2文件\路径&i&“1”&个人列表（i，1）&文件\外部
.结束

---

当文件不存在时，这将保留初始代码中的“1”。这还意味着您的列表中可以有几千个重复的名称，因为第一个John Doe文件将命名为“11John Doe”，第二个将命名为“21John Doe”，然后是“31John Doe”，等等。更轻的代码不会开始实现新库。

在保存部分设置断点。在人身上加一块手表（i，1）。当你期望它过度的看到发生了什么，看到什么？文件路径和个人列表（i，1）和FILE外文等同。您的代码应该没有问题。

。在Excel VBA中没有SaveAs2

-您是否在其他程序中使用它？或者您正在使用word文档？我正在使用word文档，通过书签将单元格中的一些值插入word文档中..mielk，我复制了模块中的函数，在main sub下面，当我点击f5时，没有错误，但是路径中也没有文件…如果在即时窗口中运行它并将一些现有路径作为参数，会发生什么情况？为什么要pu&“1”&@MacroMan谢谢你的笑声@Ram它被评论了，你想解释哪一点？@这个答案出现在低质量帖子评论队列中，所以删除了一条评论以扩展答案。@Ram啊，好的。我想这些评论解释了这一点，所以我会保持原样。我今天会试试这个，并会让你知道结果。tnx

.SaveAs2 GetNextAvailableName（“D:\template.doc”）

这样行吗？效果很好！我在

Do While

循环之前添加了

I=2

，这样就不会以“MyFile-1.ext”结束。在我看来，有“MyFile.ext”和“MyFile-1.ext”是令人困惑的。谢谢你，邦德！

While Dir(FILE_PATH & personList(i, 1) & FILE_EXT) <> ""
    i = i + 1
Wend
.SaveAs2 FILE_PATH & i & "1" & personList(i, 1) & FILE_EXT
.Close