Копирование файлов из подпапок в одну папку на основе списка в Excel - PullRequest
0 голосов
/ 13 ноября 2018

У меня есть два файла, которые находятся в двух разных подпапках. Пожалуйста, обратитесь к скриншоту ниже:

Screen Grabo of filename and Path

В настоящее время я использую следующий макрос для копирования файлов из одной папки в другую на основе списка файлов в Excel (все эти файлы находятся в одной папке), но он не позволяет копировать файлы из подпапок:

Sub copyfiles()
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String

    On Error Resume Next

    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)

    If xRg Is Nothing Then Exit Sub

    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"

    If xSFileDlg.Show <> -1 Then Exit Sub

    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"

    If xDFileDlg.Show <> -1 Then Exit Sub

    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"

    For Each xCell In xRg
        xVal = xCell.Value

        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub

Если я использую те же макросы для файлов, которые находятся в 2 подпапках, я получаю сообщение об ошибке «файл не найден». Так есть ли способ изменить тот же макрос, чтобы позволить мне копировать файлы из подпапок?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...