用途がピンポイントすぎな気もするけど、過去に何かで使ったので記載。
Public Function MkSubDir(ByVal path As String)
Dim lPath As String
If Right(path, 1) = Application.PathSeparator Then
lPath = left(path, Len(path) - 1)
MkSubDir = path
Else
lPath = path
MkSubDir = path & Application.PathSeparator
End If
If Dir(lPath, vbDirectory) <> "" Then Exit Function
Dim n As Integer
n = InStrRev(lPath, Application.PathSeparator)
If n >= 0 Then
Call MkSubDir(left$(lPath, n - 1))
End If
MkDir path
End Function
そして、正直、以下の方が全然楽です。
Office TANAKA - 番外編[存在しないパスのフォルダを一発で作成する]
http://officetanaka.net/other/extra/tips07.htm