Script to create folders and subfolders and their subfolders shows an error

[bertmg]

0
I'm attempting to create a 5 level folder having an Excel sheet as the source.
NOTE: Excel sheet is column organized by levels on each column as shown.

Reference VB script from:
Creating folders and sub-folders with a VBA macro

ERR: **'Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))**

Script:

Sub CreateFolderStructure()
Dim objRow As Range, objCell As Range, strFolders As String

For Each objRow In ActiveSheet.UsedRange.Rows
strFolders = "C:\Users\morar\Downloads\FoldersNSubsr"

For Each objCell In objRow.Cells
strFolders = strFolders & "\" & objCell
Next
**Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))**
Next
End Sub

 

[Logit]

Option Explicit

Function GetFolder() As String
Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Sub CBFolder_Click()
Application.EnableEvents = False
Application.EnableEvents = True
Dim LsR As Long
    LsR = Cells(Rows.Count, "B").End(xlUp).Row
Dim dcell As Range
Dim MainstrFolders As String
        MainstrFolders = GetFolder
    Dim strFolders As String
    For Each dcell In Range(Cells(3, 8), Cells(LsR, 8))
            strFolders = MainstrFolders & "\" & dcell.Offset(0, -6) & "\" & dcell.Offset(0, -5) & "\" & dcell.Offset(0, -4) & "\" & dcell.Offset(0, -3) & "\" & dcell.Offset(0, -2) & "\" & dcell.Offset(0, -1) & "\" & dcell.Value
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next
End Sub