在VBA中重命名文件时，为唯一名称添加增量编号

Sub RenameFileWithIncrementalNumber()
    Dim folderPath As String
    Dim fileName As String
    Dim newFileName As String
    Dim fileExtension As String
    Dim counter As Integer
    
    ' 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' 遍历目标文件夹中的文件
    fileName = Dir(folderPath & "\*.*")
    Do While fileName <> ""
        ' 判断文件名是否已存在
        counter = 1
        newFileName = Left(fileName, InStrRev(fileName, ".") - 1) ' 获取文件名（不包含扩展名）
        fileExtension = Mid(fileName, InStrRev(fileName, ".") + 1) ' 获取文件扩展名
        
        ' 添加增量编号直到找到唯一文件名
        Do While Dir(folderPath & "\" & newFileName & "_" & counter & "." & fileExtension) <> ""
            counter = counter + 1
        Loop
        
        ' 重命名文件
        Name folderPath & "\" & fileName As folderPath & "\" & newFileName & "_" & counter & "." & fileExtension
        
        ' 继续遍历下一个文件
        fileName = Dir
    Loop
    
    MsgBox "文件重命名完成。"
End Sub