При переименовании файла в VBA, добавление номера приращения для уникального имени

#excel #vba

#excel #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 amp; "*size*.xls")
     

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

Комментарии:

1. Я нигде не вижу, где вы сбрасываете fnum на 0, поэтому к каждому файлу, найденному после уже существующего, будет добавлен индекс fnum.

2. @VincentG Большое вам спасибо за указание на проблему.

Ответ №1:

Я выполнил работу, установив fnum равным нулю ниже.

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

fnum = 0
  

Комментарии:

1. Хотя этот фрагмент кода может быть решением, включение объяснения действительно помогает улучшить качество вашего сообщения. Помните, что вы отвечаете на вопрос для читателей в будущем, и эти люди могут не знать причин вашего предложения по коду.