VBA Изменение имени всех файлов в папке

#vba

#vba

Вопрос:

В папке у меня есть несколько изображений с именами 1;2;3;4;5;6 например, и мне нужно изменить имя каждого из них следующим образом :

1 становится 6 / 2 становится 5 / 3 становится 4 … и т.д.

Этот пример работает с 6 изображениями, но у меня может быть гораздо больше.

Я начинаю некоторую работу по циклическому просмотру всех файлов в каталоге

 Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("c:xxx*test*")
Do While Len(StrFile) > 0
    Debug.Print StrFile
    StrFile = Dir
Loop
End Sub
  

Возможно, мне потребуется скопировать их в другую папку, потому что я не могу назвать файл 6, если он уже существует?

Спасибо за помощь

Ответ №1:

Вы не можете переименовать файл «1» в «6», если «6» все еще там, поэтому нам нужно сначала переименовать каждый файл на временное имя. По этой причине мы дважды перебираем все файлы в папке. Обратите внимание, что файлы должны иметь имена только с номерами (плюс расширение), иначе код завершится ошибкой. Создайте резервные копии своих изображений перед запуском скрипта.

 Public Sub rename_all_files_in_folder(folderPath As String)

'''   for this code to work, Microsoft Scripting Runtime reference is required (Tools -> References)
Const temp_filename_prefix As String = "to_be_renamed_"
Dim fso As Scripting.FileSystemObject
Dim f As Scripting.file
Dim fileCount As Integer
Dim newFilename As String
Dim extension As String

Set fso = New FileSystemObject

fileCount = 0
If fso.FolderExists(folderPath) Then

    '''   first cycle, each file gets temporary name
    For Each f In fso.GetFolder(folderPath).Files
        fileCount = fileCount   1
        'fso.FindFileInFolder = f.Name
        f.Name = temp_filename_prefix amp; f.Name
    Next f

    '''   second cycle to rename from temporary name to new name
    For Each f In fso.GetFolder(folderPath).Files
        extension = "." amp; fso.GetExtensionName(f.path)
        newFilename = CStr(fileCount   1 - CInt(Replace(Replace(f.Name, temp_filename_prefix, ""), extension, ""))) amp; extension
        f.Name = newFilename
    Next f
Else
    MsgBox "Folder not found:" amp; vbCrLf amp; folderPath
End If
End Sub
  

Ответ №2:

вы могли бы использовать это:

 Public Sub SwapFiles()
    Dim folderPath As String
    Dim fileCount As Long

    folderPath = "c:xxx" ' folder path to search files into

    With CreateObject("Scripting.FileSystemObject")
        For fileCount = 1 To 3
            .CopyFile folderPath amp; "" amp; fileCount amp; ".jpg", folderPath amp; "" amp; "temp.jpg"
            .CopyFile folderPath amp; "" amp; (6 - fileCount   1) amp; ".jpg", folderPath amp; "" amp; fileCount amp; ".jpg"
            .CopyFile folderPath amp; "" amp; "temp.jpg", folderPath amp; "" amp; (6 - fileCount   1) amp; ".jpg"
        Next
    End With
End Sub
  

просто измените «jpg» на ваше фактическое расширение файлов изображений