再帰的にフォルダを作成 http://www.tetsuyanbo.net/tetsuyanblog/24247から

createfolder_src.vb

Public Function CreateFolder(strFolderPath As String)
 
' パスを\区切りで分ける
Dim varFolders As Variant   ' フォルダ名リスト
varFolders = Split(strFolderPath, "\")
 
' FileSystemObjectをインスタンス化する
Dim objFileSystemObject As Object   ' FileSystemObjectオブジェクト
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
' フォルダを作成する
Dim varValue As Variant     ' フォルダ名リストから取り出したフォルダ名
Dim strValue As String      ' CreateFolder()の戻り値
For Each varValue In varFolders
  ' 上位層からのフォルダパスを作る
  strCurrentPath = strCurrentPath & varValue & "\"
  ' フォルダがあるかチェックする
  On Error Resume Next
  If objFileSystemObject.FolderExists(strCurrentPath) = False Then
    ' フォルダがなかったら新しく作る
    strValue = objFileSystemObject.CreateFolder(strCurrentPath)
  End If
 
  ' エラーをチェックする
  If Err <> 0 Then
   ' フォルダの作成に失敗したらFor文を終了する
   MsgBox "フォルダの作成に失敗しました"
   Exit For
  End If
 Next
 
' 使い終わったら必ずNothingを設定する
Set objFileSystemObject = Nothing
 
End Function