何ができるコード?

↓ 一発で最後の階層までフォルダを作れる。

参照設定
ツール > 参照設定 > Microsoft Scripting Runtime

コード
Option Explicit
Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
ByVal hwnd As Long, _
ByVal pszPath As String, _
ByVal psa As Long) As Long
'--------------------------------------------------------------------------------
'【処理名】ディレクトリ作成
'【引数】path ディレクトリパス
'【返却値】 成功:0 失敗:0以外
'--------------------------------------------------------------------------------
Function makeDirectory(ByVal path As String) As Long
'ツール > 参照設定 > Microsoft Scripting Runtime
Dim oFSO As New FileSystemObject
makeDirectory = 0
If oFSO.FolderExists(path) <> True Then
makeDirectory = SHCreateDirectoryEx(0&, path, 0&)
End If
Set oFSO = Nothing
End Function
参考:moug様 「保存先フォルダを作成してブックを保存する(複数階層のフォルダ)」

