Скопироавть ВСЕ файлы из папки

[bes]

Доброго времени суток! Подскажите, как скопировать все файлы из одной папки в другую. Всё, что связано с сутью вопроса в данном форуме я пересмотрел, ничего подходящего мне не заметил. Попытка, используя FSO, скопировать всю папку с содержимым, а потом её переименовать не удалась - причиной этого, скорее всего, является то, что папка находится на сервере, где распределены права доступа, а копировать надо на сетевую машину. Можно ли при копировании файлов, используя FSO, применять символы маски или ещё какие предложения?

[alibek]

FSO не обязательно.
Можно использовать FileCopy.
Перебирай все файлы и копируй каждый.
Можно использовать системную функцию копирования (через WinAPI) и даже прикрутить к ней прогрессбар.

[bes]

Спасибо, попробую! Я так понимаю - это примерно в таком ключе?
Dim iPath$, iFileName$
MePath = "\\Server\DTS\"
MeFileName = Dir("\\Server\DTS\*.log")
Do While FileName <> ""
'тут что-то делаем с каждым файлом,
'............................
MeFileName = Dir 'передача названия другого файла
Loop

[alibek]

Если ты хочешь рекурсивно копировать каталоги, то алгоритм немного другой: вначале создаешь массив/коллекцию файлов, а затем обходишь каждый элемент массива/коллекции и если он является каталогом, рекурсивно вызываешь функцию.
Если этого не делать, то промежуточные состояния Dir между вызовами не сохраняются.

[bes]

Спасибо за ответ! Используя FSO я создаю папку, именуя её определённым образом. Затем, с сервера мне необходимо из "расшаренной" папки скопировать "валом" ВСЕ файлы в эту созданную папку. К сожалению, я никогда не работал с массивами и слабо представляю себе их суть. Не могли ли Вы мне подсказать на примере программного кода, как разрешить мне мою проблему... Спасибо.

[alibek]

Если через Dir:

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

Sub FileCopyRecurse(ByVal Source As String, ByVal Destination As String, Optional ByVal Mask As String = "*")
  Dim colSubDirs As Collection, V As Variant, F As String
  Set colSubDirs = New Collection
  F = Dir$(Source & "\" & Mask)
  Do While Len(F) > 0
    If (GetAttr(Source & "\" & F) And vbDirectory) = vbDirectory Then
      On Error Resume Next
      colSubDirs.Add F
      On Error GoTo 0
    Else
      On Error Resume Next
      FileCopy Source & "\" & F, Destination & "\" & F
      On Error GoTo 0
    End If
    F = Dir$
  Loop
  For Each V In colSubDirs
    MkDir Destination & "\" & V
    FileCopyRecurse Source & "\" & V, Destination & "\" & V, Mask
  Next
  Set colSubDirs = Nothing
End Sub


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

Через FSO:

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

Sub FileCopyRecurseFSO(ByVal Source As String, ByVal Destination As String)
  Dim fso As FileSystemObject
  fso.CopyFolder Source, Destination
  Set fso = Nothing
End Sub


Или так:

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

Sub FileCopyRecurseFSO(ByVal Source As String, ByVal Destination As String, Optional ByVal Mask As String = "*")
  Dim fso As FileSystemObject
  fso.CopyFile Source & "\" & Mask,Destination
  Set fso = Nothing
End Sub


Или даже так:

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

Sub FileCopyRecurseFSO(ByVal Source As String, ByVal Destination As String, Optional ByVal Mask As String = "*")
  Dim fso As FileSystemObject, CurFolder As Folder, Folder As Folder, File As File
  Set CurFolder = fso.GetFolder(Source)
  For Each Folder In CurFolder.SubFolders
    MkDir Destination & "\" & Folder.Name
    FileCopyRecurseFSO Folder.Path, Destination & "\" & Folder.Name
  Next Folder
  For Each File In CurFolder.Files
    If File.Name Like Mask Then
      File.Copy Destination
    End If
  Next
  Set fso = Nothing
End Sub


[arvitaly]

Alibek, спасибо!,

Мне вот как раз это понадобилось, а думать лень было)))

[bes]

Alibek, спасибо Вам большое за ответы! Мне, как иногда случается, не лень было подумать и я "дожал" программу по логике 3 варианта, предложенного Вами! Теперь думаю "вкрутить" в код прогрессбар для пущей наглядности процесса и ВСЁ!!!
Ещё раз большое Вам спасибо за Ваши ответы.