フォルダ構成表からフォルダを一括生成するマクロ

実務で実際に活用している汎用ツールなのですが、便利な上に、
「プロシージャ分割」「汎用関数」のいい題材でしたのでブログにも公開します。

マクロの処理内容は、

この表を元に、その通りのフォルダ群を作成するマクロです。

こういう「同じ構成のフォルダをたくさん作る」というのはたまにあって、
「業務日報」とか、「申請書の登録」なんかでも扱ったことがありますね。

こういうとき「ワークシートみたいに関数やコピーで作れたら楽なのに～」
っていつも思うので、それをマクロで実現してしまおうというツールです。

親フォルダとフォルダ構成を入力すればどこでも使用できますので、
VBAコードの参考にしたり、コードは見ずにツールだけ使ったり、
お好きなようにご活用ください。

ソースコード

Sub フォルダ構成表の通りにフォルダを一括作成する()

    Dim Path親フォルダ As String
    Path親フォルダ = Worksheets("フォルダ構成").Range("B1")
    
    If Dir(Path親フォルダ, vbDirectory) = "" Then
        MsgBox "親フォルダを作成してから実行して下さい。"
        Exit Sub
    End If

    Dim データエリア As Range
    Set データエリア = Worksheets("フォルダ構成").AutoFilter.Range
    Set データエリア = データエリア.Offset(1).Resize(データエリア.Rows.Count - 1)

    Dim データ各行 As Range
    For Each データ各行 In データエリア.Rows
    
        Dim path作成フォルダ As String
        path作成フォルダ = Path親フォルダ & "\" _
            & Join(Rangeから1次元配列を生成(データ各行, True), "\")

        Call フォルダを作成する(path作成フォルダ)

    Next
    
    MsgBox "フォルダの作成を完了しました。"

End Sub


Function Rangeから1次元配列を生成(対象Range As Range _
    , Optional is空セルは除外する As Boolean = False) As Variant

    Dim Arr生成配列() As Variant
    
    Dim i As Long: i = 0
    Dim cell As Range
    For Each cell In 対象Range.Cells
        If Not (is空セルは除外する And cell.Value = "") Then
            ReDim Preserve Arr生成配列(i) As Variant
            Arr生成配列(i) = cell.Value
            i = i + 1
        End If
    Next

    Rangeから1次元配列を生成 = Arr生成配列
End Function


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

解説

このマクロのメインコードはフォルダを作成する「MkDirステートメント」です。

このMkDirステートメントを使用する際に注意しなければいけないのが、
「ひとつ上のフォルダがないとエラーになる」
という点で、深い階層まで一気に作ることができません。

1つずつ順に作成していく必要があり、

MkDir "C:\Users\○○\Desktop\親フォルダ\果物"
MkDir "C:\Users\○○\Desktop\親フォルダ\果物\みかん"
MkDir "C:\Users\○○\Desktop\親フォルダ\果物\みかん\登録待ち"

このような実行をしていくことになります。

しかも「既にあるフォルダに実行してもエラーになる」ため、
実際は1回ごとにDir関数によるフォルダ判定も必要ですね。

さてもう一度表をみますと、

こんな表でした。

この表に対して素直にMkDirを実行していこうと思うと、

Dim R As Long, C As Long
For R = データエリア.row To GetLastR(データエリア)
    For C = データエリア.Column To GetLastC(データエリア)

    Next
Next

みたいな行⇒列の2重ループを作り、そ
の中でごちゃごちゃ判定が必要そうになります。

が、今回のコードの最後のFunctionのように、
「とにかくフルパスさえあればそこまで一気に作ってくれる」
関数を用意してあると、話が圧倒的に単純になります。

行ごとループしてフルパスを作り、後はそれを関数に渡すだけですからね。

そしてそのフルパス作成ですが、できればJoin関数を使いたいです。

しかしJoinは2次元配列禁止なため、Rangeオブジェクトは受け取ってくれません。

そこでこちらも汎用関数ですが、
「Rangeオブジェクトを渡すと1次元配列にしてくれる」
Functionを用意しておけば、RangeでJoin関数が使えるようになります。

（これは2019以降のExcelならWorksheetFunction.TextJoinで可能）

この二つを合わせると、メインコードがこんなに短く単純になります。

Dim データ各行 As Range
For Each データ各行 In データエリア.Rows

    Dim path作成フォルダ As String
    path作成フォルダ = Path親フォルダ & "\" _
        & Join(Rangeから1次元配列を生成(データ各行, True), "\")

    Call フォルダを作成する(path作成フォルダ)

Next

そして大事なのが、この2つのFunctionはこの処理を書くために作ったのではないというところですね。

両Functionとも汎用関数として既に持っていた場合は、
コピーして持ってくるだけになるということです。

そしてみなさん、もしかしたら無意識にやっていたかもしれませんが、
「Rangeから1次元配列を生成」というFunction名が読めれば、
中身は全部読み飛ばしても全く問題なくメインコードは読めます。

これも大事なプロシージャ分割の力ですね。

このように、プロシージャ分割を活用すると、
メインコードを短く簡潔に書けるようになります。

また、汎用関数(自作ライブラリ)を作って持っておくことで、
メインコードだけのコーディングでマクロが作れるようになります。

是非使ってみてください。

汎用関数の作り方についてはこちらを参考ください。
www.limecode.jp

今回使用した2つの関数の詳細はこちらをご覧ください。

www.limecode.jp
www.limecode.jp

また、ちょっと本題とはそれますが、

For Each ○○ In △△.Rows

とForEachで回すRangeオブジェクトに「Rows」を付けた場合は、
同じRangeオブジェクトでもループがセルごとではなく行ごとになることについては、こちらの記事をご覧ください。
www.limecode.jp

あとついでに本筋とそれるため関数化してませんでしたが、
「オートフィルターの見出し行をデータエリアから除外する」という処理を、
「Offset(1).Resize(元のサイズ-1)」でやっているこの部分↓

Dim データエリア As Range
Set データエリア = Worksheets("フォルダ構成").AutoFilter.Range
Set データエリア = データエリア.Offset(1).Resize(データエリア.Rows.Count - 1)

この部分は以下の関数↓を用意すると常に1行でSetできるようになります。

Function GetAutoFilterデータエリア(ws As Worksheet) As Range
    Set GetAutoFilterデータエリア = ws.AutoFilter.Range
    Set GetAutoFilterデータエリア = GetAutoFilterデータエリア.Offset(1) _
        .Resize(GetAutoFilterデータエリア.Rows.Count - 1)

' 実行例
Set データエリア = GetAutoFilterデータエリア(Worksheets("フォルダ構成"))

というかここまでくると、変数がいらなくなり、メインコードがこうなります。

Sub フォルダ構成表の通りにフォルダを一括作成する()

    Dim Path親フォルダ As String
    Path親フォルダ = Worksheets("フォルダ構成").Range("B1")
    
    If Dir(Path親フォルダ, vbDirectory) = "" Then
        MsgBox "親フォルダを作成してから実行して下さい。"
        Exit Sub
    End If

    Dim データ各行 As Range
    For Each データ各行 In GetAutoFilterデータエリア(Worksheets("フォルダ構成")).Rows
    
        Dim path作成フォルダ As String
        path作成フォルダ = Path親フォルダ & "\" _
            & Join(Rangeから1次元配列を生成(データ各行, True), "\")
    
        Call フォルダを作成する(path作成フォルダ)
    
    Next
    
    MsgBox "フォルダの作成を完了しました。"

End Sub

流石にこれ以上は削れないくらいまで短くなりましたね。

これは「テーブル」におけるDataBodyRangeプロパティを、
オートフィルターでも使えるようにした関数です。

オートフィルターをよく使う方は、テーブルが持つプロパティをまねた関数を作っておくと、テーブルの便利さをオートフィルターでも活用できるようになります。

是非作ってみてください。

おまけ：日本語関数名の強力さ

今回のコードでひとつやってみたことがあり、
既に気づいている方もいると思います。

実は今回のコード、「コメント」がひとつもありません。

でも結構読めましたよね？

というか逆に、コメントしようにもあまり書きどころがありません。

特に汎用関数に言えることなのですが、関数名を日本語にしておくと、
コメントがなくても普通に読めるようになります。

自作ライブラリの作成が進み、それがすべて母国語で書かれていると、
メインコードが普通の日本語文章みたいになります。

加えて、自作ライブラリを日本語で書くことは、
「VBAの組込み関数と自作関数が一発で見分けられる」
という恩恵も授かることができます。

これから汎用関数を作りたい、プロシージャ分割を勉強したいという方は、
是非とも関数名には母国語を採用してください。

母国語を使って学べるなら、プロシージャ分割って案外簡単ですよ。
www.limecode.jp