VBAで複数新規フォルダを一瞬でつくる方法【ネットワークフォルダ対応】

VBAのMkDirは複数の新規フォルダ作成に対応してないが、今回のコードなら複数の新規フォルダ作成が可能。

さっそく紹介していこう。

作成するまえの準備

これで準備OK。つぎはコードを紹介していく。

複数の新規フォルダ作成コード【ネットワークフォルダ対応】

Sub multipleLayersMkDir(ByVal output_folder_path As String)

    Dim file_system As New FileSystemObject
    Dim folder_lists As Variant
    Dim i As Long
    Dim folder_path As String

    folder_lists = Split(output_folder_path, "\")

    For i = 2 To UBound(folder_lists)
        folder_path = folder_path + folder_lists(i) & "\"

        If folder_path = "\" Then
            folder_path = folder_path
        ElseIf folder_path = "\\" Then
            i = i + 1
            folder_path = folder_path + folder_lists(i) & "\"
        ElseIf file_system.FolderExists(folder_path) = False Then
            MkDir folder_path
        End If

    Next i

End Sub

簡単にいえば、1階層ずつフォルダがあるか検索して、なければフォルダ作成するイメージ。

つぎからコードを簡単に説明していこう。

フォルダのフルパスを分解して配列にいれる

folder_lists = Split(output_folder_path, "\")

ここでフォルダ名ごとに分解して、配列にする。これで1つづつフォルダを検索する準備が完了だ。

output_folder_pathに作りたいフォルダ階層を設定する。

"\"を追加する

For i = LBound(folder_lists) To UBound(folder_lists)
    folder_path = folder_path + folder_lists(i) & "\"

    If folder_path = "\" Then
        folder_path = folder_path
    ElseIf folder_path = "\\" Then
        i = i + 1
        folder_path = folder_path + folder_lists(i) & "\"

ここから配列として分解した各フォルダを1つづつ読み込んでフォルダがあるか確認していくことになるが。

まずネットワークフォルダに対応するため、"\"か"\\"のときの処理をしてフォルダとして読み込めるようにしている。

フォルダが存在してない場合フォルダを作成する

ElseIf file_system.FolderExists(folder_path) = False Then
    MkDir folder_path
End If

フォルダが存在しなければMkDirでフォルダを作成していく。

コードの使いかた

Sub makingFolders()

    Dim new_folder As String
    new_folder = "作成したいフォルダパス"

    Call multipleLayersMkDir(making_folder)

End Sub

new_folderに作成したいフォルダパスを入れるだけ。ぜひ試してみてくれ。

関連【VBA】業務効率化に便利なツール【まとめ】