CreateAllDirs

Public Function CreateAllDirs(ByVal strPathName _
As String) As Boolean
'Recursively creates non-existing directories from

'the given path name

Dim strTempPath As String
Dim intPathChar As Integer
On Error Goto errCreateAllDirs
Do While Not IsDirExist(strPathName)
'Loop and parse through the string

intPathChar = InStr(intPathChar + 1, strPathName & _
IIf(Right(strPathName, 1) = "\", "", "\"), "\")
If intPathChar = 0 Then Exit Do
'Create the path name

strTempPath = Mid(strPathName, 1, intPathChar - 1)
MkDir strTempPath
Loop
CreateAllDirs = True
Exit Function
errCreateAllDirs:
Select Case Err.Number
Case 75
' Ignore errors for existing paths

Resume Next
Case Else
MsgBox Err.Number & Err.Description
End Select

End Function

Inputs:
strPathName as String A valid path name String value.

Returns:The function returns a boolean
:True if the structure is created successfully
and False if an error is encountered.
If the strPathName path already exists, the
return value is True.
Assumes:
A valid strPathName value may be of the format
Drive:\DirStruct
or \\Server\Volume\DirStruct
or \\Server\Paths.