|
Public Function CopyTree(ByVal SrcPath As String, ByVal DestPath As String) As Boolean
'//Copytree: recursively copy one directory to another, a la XCOPY /E
'//
'//Copyright (c)1996-1999 Michiel de Bruijn. '//Released for public
'//distribution, provided these comments are left intact
Dim fil As String, attr As Long, Dirs() As String, DirCount As Long, i As Long
Const TARGET_ATTR = vbNormal Or vbHidden Or vbSystem Or vbDirectory
DirCount = 0
Debug.Print "CopyTree " & SrcPath & " -> " & DestPath
On Error Resume Next
If Right(SrcPath, 1) <> "\" Then SrcPath = SrcPath & "\"
If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
'//Attempt to create destination path, in case it doesn't exist
MkDir DestPath
'//Enumerate all source files and directories
fil = Dir(SrcPath & "*.*", TARGET_ATTR)
While Len(fil)
'//Determine what kind of directory entry this is
attr = GetAttr(SrcPath & fil)
If (attr And vbDirectory) <> 0 Then
'//Found a new directory -- save it to process later, *unless* it
'//is the current or parent directory
If fil <> "." And fil <> ".." Then
DirCount = DirCount + 1
ReDim Preserve Dirs(DirCount) As String
Dirs(DirCount) = fil & "\"
End If
GoTo Continue
End If
'//Regular file: strip any special attributes from target file (just
'//in case it already exists), copy and restore original attribute
SetAttr DestPath & fil, vbNormal
FileCopy SrcPath & fil, DestPath & fil
SetAttr DestPath & fil, attr
Continue:
fil = Dir
Wend
'//All regular files are copied -- now, process any directories found
For i = 1 To DirCount
CopyTree SrcPath & Dirs(i), DestPath & Dirs(i)
Next
End Function
|
