' Скрипт из текстового файла считывает список файлов с путями относительно исходной указанной директории
' При реальном наличии указанных файлов копирует их в выходную директорию
' Структура директорий при копировании сохраняется.

FromDir = "D:\_Удали это"         		' Откуда копируем
OutDir = "D:\_Удали это тоже"         		' Куда копируем
ListFiles = "D:\_Удали это\Список файлов.txt"   ' Текстовый файл с путями копируемых файлов относительно папки Откуда копируем
    
Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
FSO.CreateFolder OutDir                 ' Создаём папку, куда копируем
On Error GoTo 0

If FSO.FolderExists(OutDir) Then                 ' Если папка существует
    On Error Resume Next
    Set FList = FSO.OpenTextFile(ListFiles, 1, False)  ' открываем файл со списком
    
    If Err.Number = 0 Then          ' Если файл со списком успешно открыт
        On Error GoTo 0
        Mass = Split(Replace(Trim(Replace(FList.ReadAll, Chr(10), "")),"/",""), Chr(13))   ' Читаем список файлов в массив
        FList.Close

        First = LBound(Mass)
        Nfiles = UBound(Mass)
               
        j = 0
        For i = First To Nfiles
            InPath = FromDir + Mass(i)

            If Len(Trim(Mass(i))) <> 0 Then
                If FSO.FileExists(InPath) Then
                mDir = Split(Mass(i), "")
                nnn = UBound(mDir) - 1

                If nnn >= 0 Then
                    MakeDir = OutDir

                    For n = 0 To nnn

                        If Len(Trim(mDir(n))) <> 0 Then
                            MakeDir = MakeDir + mDir(n) + ""

                            If Not FSO.FolderExists(MakeDir) Then        ' Если папка не существует
                                On Error Resume Next
                                FSO.CreateFolder MakeDir                 ' Создаём папку, куда копируем конкретный файл
                                On Error GoTo 0
''''                                                                    MsgBox (MakeDir)
                            End If

                        End If

                    Next

                End If

                InPath = FromDir + Mass(i)
                OutPath = OutDir + Mass(i)
                OutFileName = FSO.GetFileName(OutPath)

                If Len(Trim(OutFileName)) <> 0 Then
                    On Error Resume Next
                    Call FSO.CopyFile(InPath, OutPath, True)                 ' Создаём папку, куда копируем конкретный файл

                    If Err.Number <> 0 Then
                        Mess = MsgBox("При копировании" + InPath + vbCrLf + "в файл  " + OutPath + vbCrLf + Err.Description, 0, "Ошибка при копировании файла")
                    Else
                    	j = j + 1
                    End If
                    On Error GoTo 0
                    
                End If
                            
                Else
                    Mess = MsgBox("При копировании" + InPath + vbCrLf + "Исходный файл отсутствует", 0, "Ошибка при копировании файла")
                End If

            End If
                    
        Next

        Mess = MsgBox("Скопировано " + CStr(j) + " файлов", 0, "Копирование файлов завершено")

    Else                            ' Если файл со списком открыть не удалось
        Mess = MsgBox(ListFiles + "   " + Err.Description, 0, "Ошибка при открытии файла со списком")
    End If
Else                                ' Если папку создать не удалось
        Mess = MsgBox(OutDir + "   Папку создать не удалось", 0, "Ошибка при создании выходной папки")
End If

Echo Off
cls

Set Spis=D:\_Исходные файлы\Список файлов.txt
Set FromDir=D:\_Исходные файлы\
Set OutDir=D:\_Исходные файлы (дубль)\

FOR /F "usebackq delims==" %%i in ("%Spis%") do Call :CopyWithDir "%FromDir%%%i" "%OutDir%%%i"
GoTo End

:CopyWithDir

IF NOT EXIST %1 GoTo End

md "%~d2%~p2"
Copy %1 %2  

:End