MENU
  1. ホーム
  2. 1 フォルダ操作
  3. VBAでフォルダを一括作成！実例テンプレートをダウンロード！

VBAでフォルダを一括作成！実例テンプレートをダウンロード！

1 フォルダ操作
目次

1. はじめに

フォルダを一気に大量に作成したい！なんてことありませんか？！
今回はExcelに記述したフォルダ名でフォルダを一括に生成するVBAコードを紹介します！
入れ子構造にも対応しますので、お楽しみにして下さい！

1001_フォルダ一括作成_ver1.0-1ダウンロード

2. VBAとは？

VBA【 Visual Basic for Applications 】 とは、Microsoft Officeに含まれるアプリケーションソフトの拡張機能で、利用者が簡易なプログラムを記述して実行することで複雑な処理の自動化などを行なうことができるもの。また、そのために用意されたプログラミング言語。

Microsoft社のOfficeシリーズのソフトウェアの一部であるWordやExcel、Access、PowerPointなどで利用できる機能で、同社のプログラミング言語および実行環境であるVisual Basicの簡易版を用いてプログラムを作成することができる。これらのソフトウェアの動作の一部を変更したり、繰り返し行われる定型的な作業や複雑な処理を自動的に実行することができる。

引用：IT用語辞典 e-Words

3. VBAテンプレートの特徴

  • Excelのテーブルに記載したフォルダ名でフォルダを一括作成
  • 作成する場所はポップアップで指定
  • 階層構造（入れ子構造）にも対応し、親フォルダ、子フォルダ、孫フォルダを設定可能
  • .xlsmファイルをダウンロードし、そのまま利用可能

最後にダウンロードリンクもあります！

4. VBAテンプレートの使い方

4-1　「フォルダ名」に作成したいフォルダ名を入力する

4-2　ボタンをクリックしてフォルダを作成したいフォルダを指定する

4-3　指定したフォルダにフォルダが一気に作成されます

4-4　入れ子（階層）フォルダの作成方法

別のシートに多段階層用も用意しています！

ちゃんと階層になりました！

5. 実際のVBAコードの紹介

入れ子なし

Sub CreateFoldersFromTable()

    Dim targetFolder As String
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim r As ListRow
    Dim folderName As String
    Dim fso As Object
    
    ' ユーザーにフォルダを指定させる
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            targetFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' 現在のシートを取得
    Set ws = ThisWorkbook.ActiveSheet
    
    ' テーブル1を取得
    Set tbl = ws.ListObjects("テーブル1")
    
    ' FileSystemObjectを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' テーブルの各行をループして、フォルダを作成
    For Each r In tbl.ListRows
        folderName = r.Range.Columns(tbl.ListColumns("フォルダ名").Index).Value
        If Not fso.FolderExists(targetFolder & "\" & folderName) Then
            fso.CreateFolder targetFolder & "\" & folderName
        End If
    Next r

    Set fso = Nothing
    MsgBox "フォルダ作成が完了しました", vbInformation

End Sub
'このコードは、指定されたフォルダにテーブルから取得したフォルダ名の新しいフォルダを作成します。

入れ子１つ（親子）

Sub CreateNestedFoldersFromTable()

    Dim targetFolder As String
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim r As ListRow
    Dim parentFolderName As String
    Dim childFolderName As String
    Dim fso As Object
    
    ' ユーザーにフォルダを指定させる
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            targetFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' 現在のシートを取得
    Set ws = ThisWorkbook.ActiveSheet
    
    ' テーブル1を取得
    Set tbl = ws.ListObjects("テーブル2")
    
    ' FileSystemObjectを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' テーブルの各行をループして、フォルダを作成
    For Each r In tbl.ListRows
        parentFolderName = r.Range.Columns(tbl.ListColumns("親フォルダ名").Index).Value
        childFolderName = r.Range.Columns(tbl.ListColumns("子フォルダ名").Index).Value
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName
        End If
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName & "\" & childFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName & "\" & childFolderName
        End If
    Next r

    Set fso = Nothing
    MsgBox "フォルダ作成が完了しました", vbInformation

End Sub
'このコードは、指定されたフォルダ内に入れ子構造のフォルダをテーブルから取得した情報に基づいて作成します。

入れ子２（親子孫）

Sub CreateTripleNestedFoldersFromTable()

    Dim targetFolder As String
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim r As ListRow
    Dim parentFolderName As String
    Dim childFolderName As String
    Dim grandchildFolderName As String
    Dim fso As Object
    
    ' ユーザーにフォルダを指定させる
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            targetFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' 現在のシートを取得
    Set ws = ThisWorkbook.ActiveSheet
    
    ' テーブル1を取得
    Set tbl = ws.ListObjects("テーブル3")
    
    ' FileSystemObjectを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' テーブルの各行をループして、フォルダを作成
    For Each r In tbl.ListRows
        parentFolderName = r.Range.Columns(tbl.ListColumns("親フォルダ名").Index).Value
        childFolderName = r.Range.Columns(tbl.ListColumns("子フォルダ名").Index).Value
        grandchildFolderName = r.Range.Columns(tbl.ListColumns("孫フォルダ名").Index).Value
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName
        End If
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName & "\" & childFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName & "\" & childFolderName
        End If
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName & "\" & childFolderName & "\" & grandchildFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName & "\" & childFolderName & "\" & grandchildFolderName
        End If
    Next r

    Set fso = Nothing
    MsgBox "フォルダ作成が完了しました", vbInformation

End Sub
'このコードは、指定されたフォルダ内に[親フォルダ名]、[子フォルダ名]、[孫フォルダ名]に基づいて3つの階層で入れ子構造のフォルダを作成します。

入れ子３（親子孫ひ孫）

Sub CreateQuadrupleNestedFoldersFromTable()

    Dim targetFolder As String
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim r As ListRow
    Dim parentFolderName As String
    Dim childFolderName As String
    Dim grandchildFolderName As String
    Dim greatGrandchildFolderName As String
    Dim fso As Object
    
    ' ユーザーにフォルダを指定させる
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            targetFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' 現在のシートを取得
    Set ws = ThisWorkbook.ActiveSheet
    
    ' テーブル1を取得
    Set tbl = ws.ListObjects("テーブル4")
    
    ' FileSystemObjectを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' テーブルの各行をループして、フォルダを作成
    For Each r In tbl.ListRows
        parentFolderName = r.Range.Columns(tbl.ListColumns("親フォルダ名").Index).Value
        childFolderName = r.Range.Columns(tbl.ListColumns("子フォルダ名").Index).Value
        grandchildFolderName = r.Range.Columns(tbl.ListColumns("孫フォルダ名").Index).Value
        greatGrandchildFolderName = r.Range.Columns(tbl.ListColumns("ひ孫フォルダ名").Index).Value
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName
        End If
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName & "\" & childFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName & "\" & childFolderName
        End If
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName & "\" & childFolderName & "\" & grandchildFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName & "\" & childFolderName & "\" & grandchildFolderName
        End If
        
        If Not fso.FolderExists(targetFolder & "\" & parentFolderName & "\" & childFolderName & "\" & grandchildFolderName & "\" & greatGrandchildFolderName) Then
            fso.CreateFolder targetFolder & "\" & parentFolderName & "\" & childFolderName & "\" & grandchildFolderName & "\" & greatGrandchildFolderName
        End If
    Next r

    Set fso = Nothing
    MsgBox "フォルダ作成が完了しました", vbInformation

End Sub
'このコードは、指定されたフォルダ内に[親フォルダ名]、[子フォルダ名]、[孫フォルダ名]、[ひ孫フォルダ名]に基づいて4つの階層で入れ子構造のフォルダを作成します。

6. ダウンロード

1001_フォルダ一括作成_ver1.0ここからダウンロード

xlsmファイルを扱う際の注意点

ダウンロードしたファイルはこのような注意が出て、VBAが実行できないことがあります。その時には以下をお試しください。

右クリックで「プロパティ」を選択

「全般」の下の方にあるセキュリティを「許可する」にして「OK」

1 フォルダ操作
よかったらシェアしてね！
  • URLをコピーしました！
  • URLをコピーしました！

この記事を書いた人

sabatoのアバター sabato

実務に役立つVBAコードをダウンロードできるダウンロードセンターです。

関連記事

関連する記事はまだ見つかりませんでした。

コメント

コメントする

目次