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

EN

Option Explicit
Sub RenameAllFilesInFolder()

    Dim MyFolder As String
    Dim MyFile As String, fName As String
    Dim MyFilePatNm As String
    Dim owbk As Workbook, ws As Worksheet
    Dim v As String, fv As String, chkFile As String
    Dim strFileName As String
    Dim strFileExists As String
    Dim fnum As Integer

    MyFolder = "E:\SC_SS\"
    MyFile = Dir(MyFolder & "*size*.xls")
     

    Do Until MyFile = ""
     
        MyFilePatNm = MyFolder & MyFile
        
         Set owbk = Workbooks.Open(MyFilePatNm)
        
                Set ws = owbk.Sheets(1)
                 v = "SS_" & ws.[C3].Value
                 chkFile = v & ".xls"
                strFileName = MyFolder & chkFile
               strFileExists = Dir(strFileName)
                Do While strFileExists <> ""
                    fnum = fnum + 1
                    strFileExists = Dir(MyFolder & v & " " & fnum & ".xls")
                Loop
             
                If fnum > 0 Then
                    fv = v & " " & fnum & ".xls"
                Else
                    fv = v & ".xls"
                End If
                fName = MyFolder & fv
                ws.SaveAs Filename:=fName, FileFormat:=xlExcel8, CreateBackup:=False
                Windows(fv).Close False
                Kill MyFilePatNm
        MyFile = Dir(MyFolder & "*size*.xls")
    Loop
       
End Sub