首页 > 解决方案 > 在 VBA 中重命名文件时,为唯一名称添加增量编号

问题描述

在为更多文件运行脚本时,如果它找到相同的名称,那么它会在末尾为重复的名称添加一个递增编号,但随后它也会为某些唯一名称添加递增编号,而不是为所有唯一名称添加递增编号。

这里出了什么问题?

这是您参考的图像。在图像中,为了隐私,我隐藏了文件名的某些部分。 文件名

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

标签: excelvba

解决方案


我完成了工作,在下面将 fnum 设置为零。

If fnum > 0 Then
  fv = v & " " & fnum & ".xls"
Else
  fv = v & ".xls"
End If

fnum = 0

推荐阅读