0

Имеется excel лист, где указаны: -список файлов -полное имя файла ( ххх. pdf) -расположения файла в диске (C://xxx/xxxx/xxx.pdf) -расположения папок, куда каждый файл должен быть скопирован (C://zzz/zzzz/zz)

Как можно эти файлы скопировав распределить по указанным в листе папкам?

2 ответа 2

0

Копирование:

Sub Copy_File()
    Dim sFileName As String, sNewFileName As String

    sFileName = "C:\WWW.xls"    'имя файла для копирования
    sNewFileName = "D:\WWW.xls"    'имя копируемого файла. Директория(в данном случае диск D) должна существовать
    If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub

    FileCopy sFileName, sNewFileName 'копируем файл
End Sub

Оригинал - ссылка

0

Оператор FileCopy поможет:

FileCopy полный_путь_к_файлу, путь_вставки_с_именем_файла 

Всего одна строка, но перед ней... Нужно копировать много файлов да по разным адресам, обойти ошибки, получить имя файла из полного пути...

' копирование файлов из списка по указанным папкам'
' строка 1 - "шапка", ст.A - имена файлов, ст. B - путь копирования'
' при отсутствии папки для копирования папка создается'
' Формируется список: файлов, которые не найдены; созданных папок'
' список выводится в столбцы D:F, информация: строка, папка/файл, путь'
Sub CopyFiles()
Dim aPath(), aErr()
Dim sFName As String
Dim lRw As Long
Dim i As Long, k As Long, n As Long
    With ActiveSheet ' или другой лист: With WorkSheets("ссылки")'
        lRw = .Cells(.Rows.Count, 1).End(xlUp).Row: If lRw < 2 Then Exit Sub
        aPath = .Range("A1:B" & lRw).Value ' имена и пути в массив'
    End With

    ReDim aErr(1 To lRw * 2, 1 To 3) ' массив для ошибок'
    Application.ScreenUpdating = False

    For i = 2 To lRw
        If Dir(aPath(i, 2), vbDirectory) = "" Then ' проверяем наличие папки для копирования'
            k = k + 1: aErr(k, 1) = i
            aErr(k, 2) = "папка": aErr(k, 3) = aPath(i, 2)
            MkDir aPath(i, 2)
        End If

        If Dir(aPath(i, 1), vbDirectory) = "" Then ' файла нет'
            k = k + 1: aErr(k, 1) = i
            aErr(k, 2) = "файл": aErr(k, 3) = aPath(i, 1)
        Else ' файл есть'
            sFName = Mid$(aPath(i, 1), InStrRev(aPath(i, 1), "\")) ' извлекаем \имя_файла'
            n = n + 1: FileCopy aPath(i, 1), aPath(i, 2) & sFName  ' копируем файл'
        End If
    Next i

    If k > 0 Then ActiveSheet.Cells(2, 4).Resize(k, 3).Value = aErr ' ошибки на лист'
    Application.ScreenUpdating = True
    MsgBox "Копировано файлов: " & n & Chr$(10) & "Ошибок: " & k, 64, "OK"
End Sub

введите сюда описание изображения

Примечание: наличие диска не проверяется. Если диск (например F) отсутсствует, получим ошибку. Если такое не исключается, нужно дописать проверку:

If Dir(Split(aPath(i, 2), ":")(0), vbDirectory) = "" Then 
...

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.