目次

はじめに
完成コード
コードの解説
実際に使ってみる
まとめ

はじめに

プロジェクト管理や資料整理で、一気にフォルダ構造を作りたい場面はよくあります。A列に親フォルダ、B列以降に子フォルダを記載して、一括でフォルダを作成できるマクロを紹介します。

完成コード

実際に動作を確認できるコードを用意しました。以下の手順で試してみてください。

新しいExcelブックを開く
Alt + F11でVBエディタを開く
「ツール」→「参照設定」から「Microsoft Scripting Runtime」にチェックを入れる
「挿入」→「標準モジュール」で新しいモジュールを追加
以下のコードを貼り付けて実行

辞書を使うには参照設定が必要です。設定方法は以下の記事で解説しています。

Sub CreateFolderStructure()
    Dim fso As Scripting.FileSystemObject
    Dim baseFolder As String
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim currentPath As String
    Dim cellValue As String
    Dim folderCreated As Boolean
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    If lastRow < 1 Or ws.Cells(1, 1).value = "" Then
        MsgBox "A列にデータが存在しません。", vbExclamation
        Exit Sub
    End If
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダ作成先を選択してください"
        .AllowMultiSelect = False
        
        If .Show = -1 Then
            baseFolder = .SelectedItems(1)
        Else
            MsgBox "キャンセルされました。", vbInformation
            Exit Sub
        End If
    End With
    
    Set fso = New Scripting.FileSystemObject
    
    For i = 1 To lastRow
        cellValue = Trim(ws.Cells(i, 1).value)
        
        If cellValue = "" Then
            GoTo NextRow
        End If
        
        If Not IsValidFolderName(cellValue) Then
            MsgBox _
                "行 " & i & " のA列に不正な文字が含まれています: " & cellValue, _
                vbExclamation
                
            GoTo NextRow
        End If
        
        currentPath = baseFolder & "\" & cellValue
        If Not fso.FolderExists(currentPath) Then
            fso.CreateFolder currentPath
            folderCreated = True
        End If
        
        j = 2
        Do While ws.Cells(i, j).value <> ""
            cellValue = Trim(ws.Cells(i, j).value)
            
            If Not IsValidFolderName(cellValue) Then
                MsgBox _
                    "行 " & i & " の列 " & Split(Cells(1, j).Address, "$")(1) & _
                    " に不正な文字が含まれています: " & cellValue, _
                    vbExclamation
                
                Exit Do
            End If
            
            currentPath = currentPath & "\" & cellValue
            If Not fso.FolderExists(currentPath) Then
                fso.CreateFolder currentPath
                folderCreated = True
            End If
            
            j = j + 1
        Loop
        
NextRow:
    Next i
    
    If folderCreated Then
        MsgBox _
            "フォルダ構造の作成が完了しました。" _& vbCrLf & _
            "作成先: " & baseFolder, _
            vbInformation
    Else
        MsgBox "すべてのフォルダが既に存在していました。", vbInformation
    End If
    
    Set fso = Nothing
End Sub

Private Function IsValidFolderName(ByVal folderName As String) As Boolean
    Dim invalidChars As String
    Dim i As Long
    
    invalidChars = "\/:*?""<>|"
    
    For i = 1 To Len(invalidChars)
        If InStr(folderName, Mid(invalidChars, i, 1)) > 0 Then
            IsValidFolderName = False
            Exit Function
        End If
    Next i
    
    IsValidFolderName = True
End Function

コードの解説

【フォルダ選択ダイアログの表示】

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "フォルダ作成先を選択してください"
    If .Show = -1 Then
        baseFolder = .SelectedItems(1)
    End If
End With

FileDialogを使うと、Excelの標準的なフォルダ選択画面を表示できます。Showメソッドの戻り値が-1の場合、ユーザーがフォルダを選択したことを意味します。選択されたフォルダのパスはSelectedItems(1)で取得できます。

【FileSystemObjectの活用】

Set fso = New Scripting.FileSystemObject
If Not fso.FolderExists(currentPath) Then
    fso.CreateFolder currentPath
End If

FileSystemObjectを使うと、フォルダの存在確認や作成が簡単にできます。FolderExistsで既にフォルダがあるかチェックしてから、CreateFolderで新規作成する流れです。この方法なら、既存のフォルダを上書きする心配がありません。

【階層構造の作成】

currentPath = baseFolder & "\" & cellValue
fso.CreateFolder currentPath

j = 2
Do While ws.Cells(i, j).Value <> ""
    currentPath = currentPath & "\" & cellValue
    fso.CreateFolder currentPath
    j = j + 1
Loop

まずA列の値で親フォルダを作成し、B列以降に値がある場合はDo Whileループで順次サブフォルダを作成していきます。currentPathに次々とフォルダ名を連結することで、階層構造を実現しています。

【不正な文字のチェック】

Private Function IsValidFolderName(ByVal folderName As String) As Boolean
    Dim invalidChars As String
    invalidChars = "\/:*?""<>|"
    
    For i = 1 To Len(invalidChars)
        If InStr(folderName, Mid(invalidChars, i, 1)) > 0 Then
            IsValidFolderName = False
            Exit Function
        End If
    Next i
    
    IsValidFolderName = True
End Function

Windowsのフォルダ名には使えない文字があります。バックスラッシュ、スラッシュ、コロン、アスタリスク、疑問符、ダブルクォート、不等号、パイプの8文字です。InStr関数でこれらの文字が含まれていないかチェックし、問題があればメッセージを表示してスキップします。

InStr関数は、文字列の中に特定の文字が含まれているかを調べる関数です。見つかった場合は位置を、見つからない場合は0を返します。

実際に使ってみる

【データの準備】

シートに以下のようなデータを入力します。

A列	B列	C列
プロジェクトA	資料	提案書
プロジェクトA	資料	報告書
プロジェクトA	設計
プロジェクトB

コピペ用↓

プロジェクトA	資料	提案書
プロジェクトA	資料	報告書
プロジェクトA	設計	
プロジェクトB

この例では、以下のようなフォルダ構造が作成されます。

選択したフォルダ
├─ プロジェクトA
│  ├─ 資料
│  │  ├─ 提案書
│  │  └─ 報告書
│  └─ 設計
└─ プロジェクトB

【実行方法】

Alt + F8でマクロ一覧を開く
CreateFolderStructureを選択して実行
フォルダ選択ダイアログで作成先を選ぶ
完了メッセージが表示されたら成功

まとめ

FileDialogとFileSystemObjectを組み合わせることで、Excelのリストから柔軟なフォルダ構造を自動作成できます。プロジェクト管理や資料整理の効率化に役立ててください。