Macro to Create Folder\Sub Folder\SubFolder\

You cannot use MkDir to make complex directories as in your example, The main directory must already exist

If you want to create directory such as C:\TestMacro\Bills
, TestMacro must exist & the Function would create a subdirectory - Bills, in it

So this code will create the subdirectory if B2 produces C:\TestMacro\Bills & testMacro already exists
[

Dim sPath As String
sPath = Sheet1.Cells(3, 2).Value
MkDir sPath

Try this:

Private Sub CommandButton1_Click()
    Dim sDir As String
    
    sDir = Range("B3").Text
    
    If Len(Dir(sDir, vbDirectory)) Then
        MsgBox ("Directory already exists")
    Else
        MsgBox IIf(MakeDir(sDir), "Directory created", "Failed")
    End If
End Sub

Function MakeDir(ByVal sDir As String) As Boolean
    ' shg 2008
    ' Returns True if the directory sDir exists or is successfully created

    Static sPS  As String
    Dim astr()  As String
    Dim iLvl    As Long

    If Len(Dir(sDir, vbDirectory)) = 0 Then
        If Len(sPS) = 0 Then sPS = Application.PathSeparator

        If Right(sDir, 1) = sPS Then sDir = Left(sDir, Len(sDir) - 1)
        astr = Split(sDir, sPS)

        ' MkDir will fail if sDir contains characters 0-31
        ' or any of the characters ' < > : " / \ | ? *
        ' or if the drive does not exist
        
        sDir = ""
        On Error Resume Next
        For iLvl = 0 To UBound(astr)
            sDir = sDir & astr(iLvl) & sPS
            If Len(Dir(sDir, vbDirectory)) = 0 Then MkDir sDir
            If Err.Number <> 0 Then
                Err.Clear
                Exit Function   '---------------------------------------------->
            End If
        Next iLvl
    End If
    
    MakeDir = True
End Function

Thank you very much works a treat.

Many Thanks

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save