VBA

' You will need to add a reference to "Microsoft Scripting Runtime" for this to work
' See http://www.cpearson.com/excel/References.htm for information on how to do this

Option Explicit

Private fso As New FileSystemObject

Sub TestCreateSubDirectories()
    CreateSubDirectories ("D:\..\..\Test1\..\Test1\Test\file.txt")
End Sub

Public Function CreateSubDirectories(pathSpec As String)
    Dim pathString As String

    ' Sanitise the input
    pathString = fso.GetAbsolutePathName(pathSpec)

    If fso.FileExists(pathString) Then
        Exit Function
    End If

    If Not fso.DriveExists(fso.GetDriveName(pathString)) Then
        Call Err.Raise(666, "FileUtilities.CreateSubDirectories", "FileUtilities.CreateSubDirectories: Cannot create directory " & pathString & ", there is no " & fso.GetDriveName(pathString) & " drive")
    End If

    CreateSubDirectoriesWorker (pathString)
End Function

Private Function CreateSubDirectoriesWorker(pathString As String)
    Dim parentPathString As String

    If fso.FolderExists(pathString) Then
        ' MsgBox "Path exists, exiting - " & pathString
        Exit Function
    End If

    ' MsgBox "Path doesn't exist, recursing to parent - " & pathString
    CreateSubDirectoriesWorker (fso.GetParentFolderName(pathString))
    ' MsgBox "Creating directory " & pathString
    fso.CreateFolder (pathString)
End Function