Перемещение определенных файлов с помощью VBA

Question

Я пытаюсь переместить все наши ежедневные файлы из списка в Excel. Столбец D имеет источник, D:\Hard drive\Lee’s Hard Drive\My Documents\WBD052U_PRINT01*.txt Столбец E имеет пункт назначения, C:\Users\Lee\Documents\Work\01. WBD52U

Когда я запускаю макрос, я получаю следующую ошибку

Ошибка времени выполнения 13. Несоответствие типов.

Если я просто сделаю 1 строку, т.е.

FromPath Range(D5:D5) ToPath Range (E5:E5) 

это работает отлично.

Как только я указываю больший диапазон, он не работает. Спасибо, мне действительно нужна помощь.

   Sub Move_Certain_Files()

Dim fso, MyFile
Dim FromPath As String
Dim ToPath As String


FromPath = ActiveSheet.Range("D5:D6") '<< Change
ToPath = ActiveSheet.Range("E5:E6")   '<< Change


On Error Resume Next
Kill FromPath = ActiveSheet.Range("D5:D6")
On Error GoTo 0


Set fso = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

fso.copyFile (FromPath), ToPath, True
MsgBox "File Copied to Destination Folder Successfully", vbInformation, "Done!"


fso.copyFile Source:=FromPath, Destination:=ToPath

On Error GoTo 0

End Sub

Answer 1

Эта ошибка возникает из-за того, что вы пытаетесь установить диапазон в строковую переменную (FromPath). Вам нужно установить его в переменную Range, используя Set. Мы собираемся проработать каждый элемент в этом диапазоне. Проще всего работать с одним диапазоном столбцов (мы можем одновременно легко ссылаться на материал). Кроме того, вместо того, чтобы работать с диапазоном, чтобы подобрать, а затем выполнить копирование позже, мы можем выполнить копирование напрямую, работая с диапазоном. Вот так:

Sub Move_Certain_Files()

    Dim fso, MyFile
    Dim pathsRng As Range

    'Set range here, just the first [FROM path] column:
    Set pathsRng = ActiveSheet.Range("D5:D6")

    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next

    'Loop through paths range to copy from FROM path and paste
    'to TO path (TO path is found by using relative address (1, 2):
    For Each pathItem In pathsRng
        fso.CopyFile (pathItem.Value), pathItem(1, 2).Value, True
    Next pathItem

    'Display success/failure message:
    If Err.Number = 0 Then
        MsgBox "File(s) Copied to Destination Folder Successfully", vbInformation, "Done!"
    Else
        MsgBox "Error: Some files may not have copied.", vbInformation, "Done!"
    End If

    On Error GoTo 0

End Sub

Дополнительно: я хотел спросить, я не уверен в вашем намерении с линией:

Kill FromPath = ActiveSheet.Range("D5:D6")

Вы хотите удалить исходные файлы после копирования? Если это так, вы должны сделать это после копирования с использованием цикла - ИЛИ вы можете просто переместить файлы вместо копирования: В моем коде выше вы изменили бы следующую строку:

fso.CopyFile (pathItem.Value), pathItem(1, 2).Value, True

к этому:

fso.MoveFile (pathItem.Value), pathItem(1, 2).Value