VBA. Копирование со структурой папок

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Avsha
Сообщения: 665
Зарегистрирован: 08 сен 2005, 13:47
Откуда: KZ

Приветствую,

Уже отчаялся найти в Windows команду для копирования папки со структурой (с путем) до корневого диска.
Например, есть структура папок:
C:\Programs\Files\Path_01
C:\Programs\Files\Path_02
C:\Programs\Files\Path_03
C:\Programs\Files\Path_04
и т.д.

Необходимо скопировать папку Path_02 на сменный носитель K с cохранением всей структуры папок:
K:\Programs\Files\Path_02

Как это сделать в VBA или Windows?
bi-lya
Сообщения: 97
Зарегистрирован: 07 июн 2007, 14:08

Avsha, такие два варианта (в любом случае получаем полный путь и отметаем "С:\" )
1. копируем всю папку Programs со всеми вложенными папками и файлами и потом удалять лишнее. IMHO - неудобный, нужно перебирать все файлы в директории, не говоря о том, что размер Programs может быть и не маленьким
2. на К:\ последовательно создаем структуру согласно разбитого по "\" пути (если неизвестна структура изначально) и уже в нее копируем нужный файл
Что-то вроде того по 2-му

Код: Выделить всё

Public Sub MakeStructure()
  Dim fs As FileSystemObject
  Dim foldCr As Folder
  
  Set fs = CreateObject("Scripting.FileSystemObject")
  
  fpath = "C:\proba_1\proba_2\Проба.xls" 'получаем путь
  
  f = Split(fpath, "\")
  
  newFpath = "d:\"
  
  For a = 1 To UBound(f) - 1
    Set foldCr = fs.CreateFolder(newFpath & f(a))
    newFpath = newFpath & f(a) & "\"
  Next
  
  fs.CopyFile fpath, newFpath
  
  Set fs = Nothing
  Set foldCr = Nothing
End Sub
bi-lya
Сообщения: 97
Зарегистрирован: 07 июн 2007, 14:08

Oops...
Разговор-то про папки, а не файл
Но смысл тот же, я думаю, только используем .CopyFolder
Аватара пользователя
Aent
Сообщения: 1129
Зарегистрирован: 01 окт 2006, 14:52
Откуда: Saratov,Russia
Контактная информация:

Avsha, Есть стандартная команда xcopy. Набираем xcopy /? и читаем:
.............
/T Создает структуру папок, но не копирует файлы. Не поддерживает
пустые папки и подпапки. Сочетание /T /E
поддерживает пустые папки и подпапки.
.............
Как вызвать из VBA полагаю Вам объяснять не нужно.
Avsha
Сообщения: 665
Зарегистрирован: 08 сен 2005, 13:47
Откуда: KZ

bi-lya, спасибо за отклик

Нашел вариант ручного копирования:

1. Открываем (заходим) в папку, где лежат наши исходные файлы
2. Выделить исходный путь в строке "Адрес" и копируем в подручный блокнот
С:\Programs\Files\Path_01
3. Меняем диск С на диск К и приписываем еще команду md
md K:\Programs\Files\Path_01 (забираем в буфер)
4. Пуск\Выполнить\cmd
5. Вставка из буфера команды на создание структуры папок.
6. Копирование исходных файлов в полученную структуру папок.

надеюсь, что это все можно сделать автоматически с помощью bat-файла,
который будет предварительно копироваться в исходную папку
(немного подправляться по необходимости) и просто запускаться.

Думаю, можно этот вариант будет сделать и в виде exe-шника на VB,
используя CurDir, MkDir, FileCopy и задавая один лишь аргумент - Имя буквы диска назначения(K).


to Aent,
ключи от xcopy честно и упорно проверял, но использовать у меня их не вышло.
Может вы подскажете, что не так.
мой неработающий вариант следующий ...
xcopy С:\Programs\Files\Path_01\ K:\ /T /E
Аватара пользователя
Aent
Сообщения: 1129
Зарегистрирован: 01 окт 2006, 14:52
Откуда: Saratov,Russia
Контактная информация:

&quot писал(а):мой неработающий вариант следующий ...
xcopy С:\Programs\Files\Path_01\ K:\ /T /E
Вы неверно указали путь.
Кстати, cначала нужно создать на диске K необходимую целевую папку.
Далее код на VBA

Код: Выделить всё

Sub test()
Dim rc As Long
MkDir "k:\Path_01"
rc = Shell("c:\Windows\System32\xcopy.exe ""C:\Program Files\Path01"" k:\Path_01 /T /E", 0)
End Sub
Не забывайте, что если параметр командной строки содержит пробел, его нужно заключать в кавычки.
В нашем случае (т.к. Shell передаётся командная строка) - кавычки должны удваиваться.
Разумеется, всё легко параметризуется.
Avsha
Сообщения: 665
Зарегистрирован: 08 сен 2005, 13:47
Откуда: KZ

Aent ,
что-то ничего у меня не работает ни в VBA, ни в cmd.

А у вас xcopy с ключами /T /E в оболочке cmd работает?
Аватара пользователя
Aent
Сообщения: 1129
Зарегистрирован: 01 окт 2006, 14:52
Откуда: Saratov,Russia
Контактная информация:

&quot писал(а):А у вас xcopy с ключами /T /E в оболочке cmd работает?
Да. Никаких проблем. И из VBA и из командной строки. Только что проверил.
Windows XP SP2
А что у Вас происходит после команды ?
Avsha
Сообщения: 665
Зарегистрирован: 08 сен 2005, 13:47
Откуда: KZ

Исходные папки
-----------------------
C:\Programs\Files\Path_01
E:\Path_01

cmd...
xcopy C:\Programs\Files\Path_01 E:\Path_01 /T /E
xcopy C:\Programs\Files\Path_01 E: /T /E
- ничего не сообщает, просто опять выводит приглашение ввода C:\>

если не затруднит, приведите пожалуйста вариант вашей команды xcopy в cmd.
Аватара пользователя
Aent
Сообщения: 1129
Зарегистрирован: 01 окт 2006, 14:52
Откуда: Saratov,Russia
Контактная информация:

Avsha, возможно я не совсем понял что Вам нужно.
Приведённая вами команда Xcopy
xcopy C:\Programs\Files\Path_01 E:\Path_01 /T /E
копирует структуру папок (в том числе пустых), являющихся подпапками
C:\Programs\Files\Path_01, предполагая что E:\Path_01 уже существует
Т.е на диске E: в папке Path_01 будет восоздана структура подпапок одноимённой
папки с диска C:
Сообщений Xcopy принормальной работе не выдаёт.

Это же (c немного другими именами) делает и мой пример на VBA

Если вам нужно на диске E: восоздавать полный путь от корня
(E:\Programs\Files\Path_01) - это другой вопрос.
Ответить