recursive copy and deletion of directories
Quote:
> Dir$ is a strange function, because:
> * Calling it with no parameters can (and indeed is *meant* to) return
> different values each time.
> * Using it within subroutines messes up a parent routine which is using
> it. (There's got to be a better way of expressing it than that, probably
> involving the word "instantiation", but I'm not sure how. <g>)
> So, if you're going to use Dir$, which you'll probably have to, then use
> a closed loop and populate an array with the results. Then, you know
> that you will be able to use Dir$ in calls to subroutines (and recursion)
> without fear.
FWIW, here's a function to delete a full directory tree. Also, note that
this is different from the one in the original source book, which has a
somewhat fatal flaw <g>. Don't use that one...
======
Function dhDelTree(ByVal strDirectory As String) As Boolean
' Deletes an entire directory tree (including all
' files and subdirectories). Calls itself recursively.
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' In:
' strDirectory
' Directory to delete.
' Out:
' Return Value:
' True if successful, False if not.
' Example:
' Call dhDelTree("C:\") ' Ha! Ha! Just kidding
' Call dhDelTree("C:\DATA\MYDIR")
On Error GoTo HandleError
Dim strOriginalDir As String
Dim strFilename As String
Dim strOriginalDrive As String
Dim strCurrentDrive As String
strDirectory = dhFixPath(strDirectory)
' Check to make sure the directory actually exists.
' If not, we don't have to do a thing.
If Len(Dir(strDirectory, vbDirectory)) = 0 Then
GoTo ExitHere
End If
' Store original directory and change to one
' to be removed
If Mid$(strDirectory, 2, 1) <> ":" Then
' Invalid drive. Get out of here now!
MsgBox "Invalid drive specification. " & _
"This function does not work with UNC paths, " & _
"and requires you to supply a drive letter."
GoTo ExitHere
End If
If dhFixPath(CurDir) = strDirectory Then
MsgBox "Unable to delete the current directory. " & _
"Move to a different directory, and try again."
GoTo ExitHere
End If
' Store away the original drive/path information.
strOriginalDir = CurDir
strOriginalDrive = Left$(CurDir, 1)
' Move to the selected drive/path.
strCurrentDrive = Left$(strDirectory, 1)
ChDrive strCurrentDrive
ChDir strDirectory
' Delete all the files in the current directory
strFilename = Dir("*.*")
Do Until strFilename = ""
Kill strFilename
strFilename = Dir
Loop
' Now build a list of subdirectories
Do
strFilename = Dir("*.*", vbDirectory)
' Skip "." and ".."
Do While strFilename = "." Or strFilename = ".."
strFilename = Dir
Loop
' If there are no more files, exit the loop
' otherwise call dhDelTree again to wipe
' out the subdirectory
If strFilename = "" Then
Exit Do
Else
If Not dhDelTree(dhFixPath(CurDir) & strFilename) Then
GoTo ExitHere
End If
End If
Loop
' Change back to the original directory
ChDrive strOriginalDrive
ChDir strOriginalDir
' Finally, remove the target directory
RmDir strDirectory
dhDelTree = True
ExitHere:
Exit Function
HandleError:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number & " in dhDelTree"
Resume ExitHere
End Select
End Function
Function dhFixPath(strPath As String) As String
' Make sure path name includes a trailing backslash.
' Get rid of any extraneous spaces
strPath = Trim(strPath)
' Stick a backslash on the end of the path
If Right$(strPath, 1) <> "\" Then
dhFixPath = strPath & "\"
Else
dhFixPath = strPath
End If
End Function
