Excel VBA Макросы: Перенести файлы из папки на основании столбцов Excel.

[go_hard_follow]

Задача такая. Есть 2 столбца, в одном названия городов, в другом наименование фото:
Новосибирск | 11.jpg
Новосибирск | 12.jpg
Москва | 15.jpg
Москва | 16.jpg
Сочи | 18.jpg

Также есть папка «фото» на диске С, в ней все фото. Надо эти фото перенести в папки городов на основе этих столбцов, чтобы получилось например из c:/фото/15.jpg в c:/фото/Москва/15.jpg.

Папки с городами макрос должен создавать.

[Администратор]

В пункте 1 укажите ваш путь.

Макрос

Sub Макрос()

    Dim путь As String, ИмяФайла As String, ПапкаГород As String
    Dim lr As Long, i As Long
   
   
    '1. Запись в переменную пути.
    путь = "C:\Users\User\Desktop\Фото"
   
    '2. Поиск последней строки, в которой есть данные.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
    '3. Перемещение файлов в указанную папку.
    ' Движение по строкам со второй по последнюю.
    For i = 2 To lr
   
        '1) Копирование данных из экселя в переменные для удобства чтения кода.
        ' Запись города в переменную.
        ПапкаГород = Cells(i, "A").value
        ' Запись имени файла в переменную.
        ИмяФайла = Cells(i, "B").value
       
        '2) Создание папки.
        On Error Resume Next
        MkDir путь & "\" & ПапкаГород
        On Error GoTo 0
       
        '3) Перемещение файла.
        ' Копирование файла.
        FileCopy путь & "\" & ИмяФайла, путь & "\" & ПапкаГород & "\" & ИмяФайла
        ' Удаление файла.
        Kill путь & "\" & ИмяФайла
       
    Next i
   
    '4. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[go_hard_follow]

спасибо