ちょっとだけ苦労したのでメモります。

参考サイト：
http://www.ne.jp/asahi/hishidama/home/tech/excel/vba/tips.html#MkDirs

------------------------------------------------------------

Sub MkDirs(ByRef path As String)
    '存在していたら何もしない
    If Dir(path, vbDirectory) <> "" Then Exit Sub

    Dim n As Integer
    n = InStrRev(path, "\")
    If n >= 0 Then
        Call MkDirs(Left$(path, n - 1))
    End If

    If Dir(path, vbDirectory) <> "" Then Exit Sub

    MkDir path
End Sub

------------------------------------------------------------

私の環境ではそのままの使用では思った動作をしてくれなかったので赤文字を追加しました。
この赤文字は青文字のコピーです。