Public Function CreateFolderRecursive(ByVal FolderSpec As String) As Boolean
'Function
'   Used to create folders recursivly.
'Parameters
'   FolderSpec (String) = The complete spec of the folder to create.
'       Example: c:\newfolder\anotherfolder\yetanotherfolder
'       If there are 1 or more backslashes (\) at the end, they are ignored.
'Return (Boolean)
'   Returns True if all folders were created and no error occured.
'   Returns False if any error occured.
'Exit Conditions
'   The Err object is clear if no errors occured.
'   The Err object contains error information if any errors occured.
'Notes
'   If some of the folders specified in the FolderSpec already exist, those folders are not changed.
'       Only the folders which do not exist and which are necessary to complete the FolderSpec are created.
'   This function works only when FolderSpec contains a leading drive letter.
'           It will not work with network URLs.
'Version History
'   1.0 8/7/2003 Tested by Russ Tanner
'---

'Initiate variables
Dim xPath As String 'name of the current folder to create
Dim X As Integer 'index of the next backslash

'Default return value
CreateFolderRecursive = False

'Use inline error trapping
On Error Resume Next
Err.Clear

'Main loop
Do

    'Parse the next folder name
    X = InStr(FolderSpec, "\") 'get the index of the first path delimiter
    'The foldespec does not contain another path delimiter
    If X = 0 Then
        xPath = xPath & "\" & FolderSpec
        FolderSpec = ""
    'The folderspec contains another path delimiter
    Else
        xPath = xPath & IIf(xPath <> "", "\", "") & Left(FolderSpec, X - 1)
        FolderSpec = Mid(FolderSpec, X + 1)
    End If

    'Create folder if it doesn't already exist
    If Dir(xPath, vbDirectory) = "" Then
        'Create the folder
        MkDir xPath
        'Trap: Error occured, return False and exit now
        If Err.Number <> 0 Then Exit Function
    End If

Loop While FolderSpec <> ""

'No errors occured, return True
CreateFolderRecursive = True

End Function