Saving files to directory and subdirectory

Question

I am trying to save a file based on cell value in a directory and sub-directory based on cell values. The goal is for the code to check to see if the directory and sub-directory are present and then create the folders if necessary. Can someone show me and explain how I can alter this code to make the sub-directory?

This code is for checking/creating the first directory and saving the file within it.

Sub Macro4()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Worksheets("Private").Range("M2").Value ' New directory name

strFilename = Worksheets("Sheet2").Range("C1").Value 'New file name
strDefpath = Environ("USERPROFILE") & "\Documents\Folder1\" & Worksheets("Private").Range("L2").Value 'Default path name"
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string

    Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

This is what I've tried to make a sub-directory in addition to the initial directory.

Sub Macro4()
Dim strFilename, strDirname, strDir2name, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Worksheets("Private").Range("L2").Value 'New directory name
strDir2name = Worksheets("Private").Range("M2").Value ' New directory 2 name

strFilename = Worksheets("Sheet2").Range("C1").Value 'New file name
strDefpath = Environ("USERPROFILE") & "\Documents\Folder1" 'Default path name"
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strDir2name) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & "\" & strDirname & "\" & strDir2name
strPathname = strDefpath & "\" & strDirname & "\" & strDir2name & "\" & strFilename 'create total string

    Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

Answer 1

If you can get a directory you wish to save in, as a String, you can use the two below:

Sub Test()
Dim myDir as String
myDir = "C:\Users\Beedle\MyFolder\subFolder\"
MyMkDir myDir
' Now you can save/do whatever with myDir.
End Sub

And the sub, which will create all necessary folders. (So if you just have C:\Users\Beedle, it'll create MyFolder and subFolder in MyFolder:

Public Sub MyMkDir(sPath As String)
'https://www.devhut.net/2011/09/15/vba-create-directory-structurecreate-multiple-directories/
Dim iStart          As Integer
Dim aDirs           As Variant
Dim sCurDir         As String
Dim i               As Integer

If sPath <> "" Then
    aDirs = Split(sPath, "\")
    If Left(sPath, 2) = "\\" Then
        iStart = 3
    Else
        iStart = 1
    End If

    sCurDir = Left(sPath, InStr(iStart, sPath, "\"))

    For i = iStart To UBound(aDirs)
        sCurDir = sCurDir & aDirs(i) & "\"
        If Dir(sCurDir, vbDirectory) = vbNullString Then
            MkDir sCurDir
        End If
    Next i
End If
End Sub