保存先のフォルダがなかったら作る

---

これは意外と奥が深い問題です。「C:\tmp\sub」というフォルダの存在を調べて、もし存在しなかったら作成したいわけですが「sub」ではなく「tmp」が存在しない可能性もあります。「C:\tmp」が存在しない場合は、FSO.CreateFolder "C:\tmp\sub" はエラーになります。そこで「対象フォルダの親フォルダが存在するかどうかを調べる」プロシージャを再帰的に呼び出して、存在するパスを見つけます。

なお、SHCreateDirectoryExというAPIを使うと、このように存在しない深いパスを一発で作成することができます。興味のある方は、下記のページをご覧ください。

存在しないパスのフォルダを一発で作成する

Sub Sample10()
    Dim NewPath As String
    NewPath = InputBox("保存するフォルダのパスを入力してください" & vbCrLf & _
                       "例:C:\tmp\sub (必ずルートから)")
    ''[キャンセル]だったら終了
    If NewPath = "" Then Exit Sub
    ''親フォルダまでが存在するかチェックする
    Call CheckparentFolder(NewPath)
    ''サンプルのファイルを保存する
    If Right(NewPath, 1) <> "\" Then NewPath = NewPath & "\"
    Open NewPath & "Sample.txt" For Output As #1
        Print #1, Now()
    Close #1
End Sub

Sub CheckparentFolder(TargetFolder)
    Dim ParentFolder As String, FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''調査対象フォルダの、親フォルダ名を取得する
    ParentFolder = FSO.GetParentFolderName(TargetFolder)
    If Not FSO.FolderExists(ParentFolder) Then
        ''親フォルダが存在しなかったら、
        ''親フォルダを新しい対象フォルダとして
        ''自分自身(Sub CheckparentFolder)を呼び出す
        Call CheckparentFolder(ParentFolder)
    End If
    ''新しいフォルダを作る
    FSO.CreateFolder TargetFolder
    Set FSO = Nothing
End Sub