深い階層まで一気にフォルダを作成する

フォルダを作成する「MkDirステートメント」は、
フォルダをひとつずつしか作成できないため、
親フォルダがまだないフォルダの作成を指示するとエラーになります。

例えば「商品」フォルダしかまだない状況で、

このフォルダを作成するには、

MkDir "C:\Users\○○\Desktop\商品\くだもの"
MkDir "C:\Users\○○\Desktop\商品\くだもの\柑橘"
MkDir "C:\Users\○○\Desktop\商品\くだもの\柑橘\みかん"

このように上の階層から順に作成していく必要があります。

また、MkDirステートメントは「既にあるフォルダ」を指定してもエラーになるため、

MkDir "C:\Users\○○\Desktop\商品"

これは書いてはいけないというのも面倒なポイントですね。

これらを考慮し、あるフォルダパスを指定した際に、
その親たちも含めて一気に作成していくコードがこちらになります。

Sub 深い階層まで一気にフォルダを作成する()
        
    Dim 作成フォルダのフルパス As String
    作成フォルダのフルパス = "C:\Users\○○\Desktop\商品\くだもの\柑橘\みかん"

    ' パスを\で分割して、各階層のフォルダ名を配列に格納
    Dim Arr階層ごとのフォルダ名() As String
    Arr階層ごとのフォルダ名 = Split(作成フォルダのフルパス, "\")
    
    ' フォルダ作成まわりのエラーは無視
    On Error Resume Next
    
    ' For文で「\フォルダ名」を1つずつ付け足しながら順にフォルダを作成していく
    Dim 作成フォルダパス As String
    作成フォルダパス = Arr階層ごとのフォルダ名(0)
    Dim i As Long
    For i = 1 To UBound(Arr階層ごとのフォルダ名)
        作成フォルダパス = 作成フォルダパス & "\" & Arr階層ごとのフォルダ名(i)
        MkDir 作成フォルダパス
    Next

    ' エラー無視設定を解除
    On Error GoTo 0

    ' 作成できたかどうかは最後にフォルダが存在するかで判定
    If Dir(作成フォルダのフルパス, vbDirectory) <> "" Then
        ThisWorkbook.SaveAs 作成フォルダのフルパス & "\" & "～～～～.xlsx"
    Else
        MsgBox "フォルダが作成できませんでした。"
    End If

End Sub

　
まずはSplit関数を使ってフォルダパスを分解し、
各階層のフォルダ名を格納した配列を作ります。

C:\Users\○○\Desktop\商品\くだもの\柑橘\みかん
↓"\"でSplitした配列
[C:|Users|○○|Desktop|商品|くだもの|柑橘|みかん]

その配列をFor文で1階層ずつループして、
作成するフォルダパスに「\次のフォルダ名」を順次付け足し、
そのフォルダパスをMkDirで作成していくコードです。

For	作成フォルダパス
初期値	C:
i=1	C:\Users
i=2	C:\Users\○○
i=3	C:\Users\○○\Desktop
i=4	C:\Users\○○\Desktop\商品
i=5	C:\Users\○○\Desktop\商品\くだもの
i=6	C:\Users\○○\Desktop\商品\くだもの\柑橘
i=7	C:\Users\○○\Desktop\商品\くだもの\柑橘\みかん

全階層きっちり判定しますので、
ユーザー側は「どの階層まで作成済みか」を意識する必要はありません。

既にフォルダがあった場合のエラーについては、
On Error Resume Nextでスキップしています。

律儀に「フォルダがなければ作成する」コードを書くと、
For文の内部はこのように書くことになります。

For i = 1 To UBound(Arr階層ごとのフォルダ名)
    作成フォルダパス = 作成フォルダパス & "\" & Arr階層ごとのフォルダ名(i)
    If Dir(作成フォルダパス, vbDirectory) = "" Then
        MkDir 作成フォルダパス
    End If
Next

通常この書き方をしても問題はないのですが、
作成フォルダが「共有サーバー」である場合などで、
i=1、i=2のあたりでレアケースのエラーになることがあります。

※ \\0.0.0.0\xxx\～～～ などのフォルダで、\\部分でSplitが動かなかったり、
Dir関数にIPアドレスを渡すときの微妙な挙動の違いなどがあります。

そういう序盤のエラーはこのマクロには関係がありませんので、
とりあえずスキップしておきましょう。

最後まで作れたかどうかは、
「For文が終わった後、作りたかった最終目標フォルダが存在しているか」
で判定をすれば問題はありません。

汎用関数化

上記のコードを見るとわかりますが、このコードはほぼコピペで動かすコードです。

変更するのは「作成フォルダのフルパス」だけですね。

こういったボリュームが大きい割にほぼコピペのコードは、
関数化することで、本体マクロを簡潔にすることができます。

' 本体マクロ上の記述
Dim 作成フォルダのフルパス As String
作成フォルダのフルパス = "C:\Users\○○\Desktop\商品\くだもの\柑橘\みかん"

Call フォルダを作成する(作成フォルダのフルパス)
ThisWorkbook.SaveAs 作成フォルダのフルパス & "\" & "～～～～.xlsx"

' 汎用関数
Function フォルダを作成する(ByVal 作成フォルダのフルパス As String) As Boolean

    Dim Arr階層ごとのフォルダ名() As String
    Arr階層ごとのフォルダ名 = Split(作成フォルダのフルパス, "\")

    On Error Resume Next
        Dim 作成フォルダパス As String
        作成フォルダパス = Arr階層ごとのフォルダ名(0)
        Dim i As Long
        For i = 1 To UBound(Arr階層ごとのフォルダ名)
            作成フォルダパス = 作成フォルダパス & "\" & Arr階層ごとのフォルダ名(i)
            MkDir 作成フォルダパス
        Next
    On Error GoTo 0
    
    If Dir(作成フォルダのフルパス, vbDirectory) <> "" Then フォルダを作成する = True
End Function

　
本体コードがかなりスッキリしましたね。

変更するのが「作成フォルダのフルパス」のみでしたので、
汎用関数も引数1つで、本体マクロでも1行で終わっています。

また、この関数は「成否」も返すようになっていますので、
何らかの理由でフォルダが作れなかった場合の分岐も、

If フォルダを作成する(作成フォルダのフルパス) = True Then
    ThisWorkbook.SaveAs 作成フォルダのフルパス & "\" & "～～～～.xlsx"
Else
    MsgBox "フォルダが作成できませんでした。"
End If

このようにIfステートメント内に作成関数を書くことで実装できます。

関数作成と聞くと難しく聞こえるかもしれませんが、
上記の関数の中身は、冒頭のコードそのままです。

今回のようにコピペコードをCallするだけの関数は、
引数の設定も特に悩むことはなく作成が簡単で、
その割に行数が多かった分効果が大きいです。

関数作成の練習にもピッタリだと思いますので活用してみてください。