【Excel VBA】大量の空フォルダを一度に作成するプログラム【MkDir】

【Excel VBA】大量の空フォルダを一度に作成するプログラム【MkDir】

どうも青瓶です。

今回はExcel vbaで大量のフォルダを一度に作成するプログラムを紹介します。

下記のコードのプログラム1の設定値をお好みの値に変えるだけでそのまま使うことができます。

↓こんな感じで指定したアドレスに大量の空フォルダを短時間で作成することができます。

スポンサーリンク

コード


Option Explicit

'プログラム1:設定値
'---------------------------------------------------
Sub AddressList()

    Dim ads As String
    Dim mot As String
    Dim cld As String
    Dim n As Long
    
    'フォルダ作成アドレス
     ads = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

    '親フォルダ名
    mot = "2022年"

    '子フォルダ名
    cld = "データ"
    
    '子フォルダ作成数
    n = 1000
        
    'フォルダ一括作成
    Call FolderMake(ads, mot, cld, n)

End Sub

'プログラム2:フォルダ一括作成
'---------------------------------------------------
Private Sub FolderMake(ByVal ads As String, ByVal mot As String, ByVal cld As String, ByVal n As Long)

    Application.ScreenUpdating = False
    
    Dim i As Long
 
    '親フォルダを作成
    '---------------------------------------------
    If Dir(ads & mot, vbDirectory) = "" Then MkDir ads & mot
    
    '子フォルダを作成
    '---------------------------------------------
    For i = 1 To n
        If Dir(ads & mot & "\" & cld & FName(i), vbDirectory) = "" Then
            MkDir ads & mot & "\" & cld & FName(i)
        End If
    Next i
    
    MsgBox "フォルダの一括作成が完了しました。", vbInformation
    
    Application.ScreenUpdating = True
    
End Sub

'プログラム3:iを4桁の数値に変更
'---------------------------------------------------
Private Function FName(ByVal i As Long) As String

    Select Case Len(CStr(i))
        Case 1: FName = "000" & i
        Case 2: FName = "00" & i
        Case 3: FName = "0" & i
        Case 4: FName = i
    End Select
    
End Function

プログラム解説

プログラム1:設定値

まずプログラム1でフォルダ保存先アドレス(ads)、親フォルダ名(mot)、子フォルダ名(cld)、子フォルダ作成数(n)を設定します。

お好みのアドレス、フォルダ名、フォルダ作成数に各変数を変更してください。

プログラム2:フォルダ一括作成

次にプログラム2でフォルダの作成を実行します。
まず指定されたアドレスに親フォルダを作成します。

この時、既に同名フォルダが存在していた場合はフォルダの作成は行いません。

If Dir(ads & mot, vbDirectory) = "" Then

親フォルダ作成後、子フォルダを作成していきます。

子フォルダも親フォルダ同様に既に同名フォルダが存在する場合はフォルダ作成は行いません。

子フォルダはn(初めに設定した値)個作成します。

For i = 1 To n
    If Dir(ads & mot & "\" & cld & FName(i), vbDirectory) = "" Then
         MkDir ads & mot & "\" & cld & FName(i)
    End If
Next i

子フォルダの名前は共通名称(cld)にナンバー(n)を付けたものになります。

上記プログラムをコピペして動かした場合は”データ0001″,”データ0002″…と言った感じにフォルダが作られます。

プログラム3:iを4桁の数値に変更

ファンクションFNameでファイルナンバーを4桁の数値に変更します。

この機能はオプションの機能なので不要な場合はFName(i) の部分を i に変更すればこの処理は行われません。

取得したナンバーの文字数を

Len(CStr(i))

で求めて、1桁の場合はナンバーの頭に0を3つ、2桁の場合はナンバーの頭に0を2つ、3桁の場合はナンバーの頭に0を1つ追加した文字を返します。
4桁の場合は何もしません。

Case 1: FName = "000" & i
Case 2: FName = "00" & i
Case 3: FName = "0" & i
Case 4: FName = i

結構限定的な状況で使用するプログラムにはなりますが良ければ参考にしてみて下さい。