CopyTree Function

This procedure was written to replicate, within VB, the action of selecting a folder and copying it, along with its lower level folders and files to a new directory location, while maintaining the same directory structure. By doing so this provides the same drag and drop feel as Windows Explorer when used in conjunction with the Drive, Directory and File Object collection for moving multiple dirs/files between a source and destination location. The procedure first interrogates the directory structure to map all the nested folders, then creates these under the destination directory. That done, all the files associated with each directory are identified and copied. Folder creation and file copying are intentionally carried out in two separate steps to avoid system delays leading to files being copied to folders which haven't been created in time. Three other procedures are employed to provide additional error trapping, these are CopyFile, CreatePath & GetFolderName. Add the following code to a FileHandling.bas standard module to compile a File Utility function set:

Public Sub CopyTree(SourcePath As String, DestinationPath As String)

'*************************************************************
'<DESC>		Copies folders and nested folders and files to
'		new directory location</DESC>
'<RETURN>		None</RETURN>
'<ACCESS>		Public</ACCESS>
'<ARGS>		SourcePath(String): 
'			Path of source directory
'		DestinationPath(String):
'			Path of destination directory</ARGS>	
'<USAGE>		Call CopyTree("C:\Program Files\DevStudio\, ">C:\Temp\")
'		</USAGE>
'*************************************************************

    'declare array using user defined datatype
    Dim arrDirData(1000) As DirData
    Dim intLoopCount As Integer
    Dim intLoopVal As Integer
    Dim intPositionFlag As Integer
    Dim filnam As String
    Dim DirSearchComplete As Boolean
    
    'set to true in case no dirs are found in 1st pass
    DirSearchComplete = True
    
    'add highest level dir to array and flag as searched
    arrDirData(0).Path = SourcePath
    arrDirData(0).IsSearched = True
    
    'Retrieve the first entry.
    filnam = Dir(SourcePath & "*.*", vbDirectory + _
      vbNormal + _vbHidden + vbSystem)
    
    Do While filnam <> ""
        'Ignore the current directory and the 
        'encompassing directory.
        If filnam <> "." And filnam <> ".." Then
            'Use bitwise comparison to check if 
            'filnam is a dir or file.
            If (GetAttr(SourcePath & filnam) And vbDirectory) = _
              vbDirectory Then
                intLoopCount = intLoopCount + 1
                arrDirData(intLoopCount).Path = _
                  SourcePath & filnam & "\"
                'flag dir hasn't been searched
                arrDirData(intLoopCount).IsSearched = False 
                ' dirs found
                DirSearchComplete = False
            End If
        End If
        'Get next entry.
        filnam = Dir
    Loop
    
    'set array postion flag to 1, 
    'as element 0 has been searched
    intPositionFlag = 1

    'now loop thru array 2 interogate all nested dirs
    Do Until DirSearchComplete = True
        ' set initial state 2 B changed in loop below
        DirSearchComplete = True 
        If arrDirData(intPositionFlag).IsSearched = False Then
            filnam = Dir(arrDirData(intPositionFlag).Path & _
              "*.*", vbDirectory + vbNormal + vbHidden + vbSystem)
            Do While filnam <> ""
                If filnam <> "." And filnam <> ".." Then
                    If (GetAttr(arrDirData(intPositionFlag).Path & _
                      filnam) And vbDirectory) = vbDirectory Then
                        'inc 4 next dir found in explorer
                        intLoopCount = intLoopCount + 1 
                        arrDirData(intLoopCount).Path = _
                          arrDirData(intPositionFlag).Path & filnam & "\"
                        ' dir not searched flag
                        arrDirData(intLoopCount).IsSearched = False
                        ' dirs found                        
                        DirSearchComplete = False
                    ElseIf intPositionFlag < intLoopCount Then
                        ' dirs exist in array 2 B searched
                        DirSearchComplete = False 
                    End If
                End If
                filnam = Dir
            Loop
            'Now dir's search is complete, set flag accordingly
            arrDirData(intPositionFlag).IsSearched = True
        End If                                   
        intPositionFlag = intPositionFlag + 1
    Loop
    
    'create new folders 2 B copied in destination directory
    For intLoopVal = 0 To intLoopCount
        If arrDirData(intLoopVal).IsSearched = True Then
            Call CreatePath(DestinationPath & _
              Mid(arrDirData(intLoopVal).Path, _
              Len(SourcePath) - Len(GetFolderName(SourcePath))), 0)
        End If
    Next intLoopVal
    
    'Copy all files to appropriate destination directories.
    'This code resides outside the above loop to 
    'allow windows to finish
    'creating the dirs before copying the associated files...
    For intLoopVal = 0 To intLoopCount
        If arrDirData(intLoopVal).IsSearched = True Then
            filnam = Dir(arrDirData(intLoopVal).Path & "*.*", _ 
              vbDirectory + vbNormal + vbHidden + vbSystem)
            Do While filnam <> ""
                If filnam <> "." And filnam <> ".." Then
                    If Not ((GetAttr(arrDirData(intLoopVal).Path &_ 
                      filnam) And vbDirectory) = vbDirectory) Then
                        Call CopyFile(arrDirData(intLoopVal).Path & _
                          filnam, DestinationPath & _
                          Mid(arrDirData(intLoopVal).Path, Len(SourcePath) _
                          - Len(GetFolderName(SourcePath))) & filnam, 0)
                        DoEvents
                    End If
                End If
                filnam = Dir$
            Loop
        End If
    Next intLoopVal
End Sub