如果该文件已存在于目录中，则用另一个名称保存
我不知道这个代码我错了。
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文件。
以下是可用于为任何给定path检索唯一文件名的function。 它将后缀名为" - 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
我使用一些非常相似的东西来提供文件。 可以看看你是否可以改变你的需求
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
我有这个function挂了一个年龄 – 不知道我从哪里得到它。 如果文件名没有扩展名，或者有超过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
很多这些都是很长的答案，看起来像一个非常简单的问题。 大多数引用FileSystemObject; 我注意到你没有引用。
我的解决scheme是使用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
当文件不存在时，这会保留初始代码中的“1”。 这也意味着你可以在你的列表中有几千个重复的名字，因为第一个John Doe的文件将被命名为“11John Doe”，第二个将是“21John Doe”，然后是“31 John Doe”等等。没有开始实施新的图书馆。
这里是创build独特的文件path的function（取自http://mielk.pl/） ：
Public Function uniqueFilePath(filepath As String) As String Const METHOD_NAME As String = "uniqueFilePath" '------------------------------------------------------------------------------------------------------ Static objFSO As Object '(Late binding that allows to use the function, even if 'Microsoft Scripting Runtime library is not loaded) Dim strFileExtension As String Dim strFileName As String Dim strParentFolder As String Dim strTempFilePath As String Dim intCounter As Integer '------------------------------------------------------------------------------------------------------ 'Create FileSystemObject instance if it hasn't been created yet. ------------------------------------| If objFSO Is Nothing Then '| Set objFSO = VBA.CreateObject("Scripting.FileSystemObject") '| End If '| '----------------------------------------------------------------------------------------------------| With objFSO 'Checks if the file already exists. -------------------------------------------------------------| If .fileExists(filepath) Then '| '| 'If the given filepath already exists, function transforms its name by '| 'appending the number in brackets. '| strParentFolder = .GetParentFolderName(filepath) '| If Not VBA.right$(strParentFolder, 1) = "\" Then strParentFolder = strParentFolder & "\" '| strFileName = .GetBaseName(filepath) '| strFileExtension = "." & .GetExtensionName(filepath) '| '| '------------------------------------------------------------------------------------| '| Do '| '| intCounter = intCounter + 1 '| '| strTempFilePath = strParentFolder & strFileName & _ " (" & intCounter & ")" & strFileExtension '| '| Loop While .fileExists(strTempFilePath) '| '| '------------------------------------------------------------------------------------| '| '| uniqueFilePath = strTempFilePath '| '| Else '| '| 'Specified filepath is unique in the file system and is returned in its original form. '| uniqueFilePath = filepath '| '| End If '| '-------- [If .FileExists(filepath) Then] -------------------------------------------------------| End With End Function
为了使下面的代码正常工作，您必须将其粘贴到您的代码中。
如果作为参数给出的文件path已经存在，则函数返回与附加括号中的数字相同的文件path ，即如果文件“C：\ file.xlsx”已经存在，则函数返回“C：\ file（1）.xlsx”。
如果此文件不存在，则该函数将返回原始文件path而不做任何更改。
用你的问题把你粘贴的所有代码replace成下面的代码：
Dim filepath As String filepath = uniqueFilePath(FILE_PATH & personList(i, 1) & FILE_EXT) Call .SaveAs(filepath) Call .Close
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