VBA переименовывает файлы в папке, сохраняя правильный порядок

Question

Я нашел этот код, который переименовывает все файлы в определенную папку.

Const FolderLoc = "C:\Users\chf000\Desktop\AAA\"
Dim x As Long
x = 1
Dim s As String
s = Dir(FolderLoc & "*.*")
Do While s <> ""
       Name FolderLoc & s As FolderLoc & "ANIMATIC-" & x & ".png"
    s = Dir()
    x = x + 1
Loop

Это работает, но у меня возникла проблема при переименовании. По сути, у меня есть последовательность png в папке, например: SHOT001_00.png и SHOT001_01.png и так далее. последовательность имеет более 100 кадров. скрипт меняет имя с SHOT001_00.png на ANIMATIC-0.png и так далее. Когда я запускаю скрипт, файлы переименовываются в неправильном порядке. Например, файл с именем ANIMATIC-12.png содержит изображение, которое принадлежит кадру 101. Я предполагаю, что проблема в том, как скрипт сортирует файлы в папке, сортирует их в алфавитном порядке, а не по порядку номеров. Кто-нибудь знает, как мне отредактировать скрипт, чтобы переименовать и сохранить правильный порядок? Спасибо

Answer 1

Я думаю, что вы должны сначала поместить все имена в массив, а затем переименовать их из этого списка.
Я использую этот код, чтобы получить список файлов в массив:

Private Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

    'Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

    '   Error handler
NoFilesFound:
    GetFileList = False
End Function