ＶＢＡを使ってフォルダを再帰的に作成するマクロ

VBAを使って、セル範囲に入力されたフォルダパスに従って再帰的にフォルダを作成するマクロを以下に示します。このマクロは、セルA1から最終行までの各セルの値を読み取り、その値に従ってフォルダを作成します。

Sub CreateFolders()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim folderPath As String
    
    ' シートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' A列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' A1から最終行までループ
    For Each cell In ws.Range("A1:A" & lastRow)
        folderPath = cell.Value
        
        If Len(folderPath) > 0 Then
            CreateFolderRecursively folderPath
        End If
    Next cell
    
    MsgBox "フォルダの作成が完了しました。", vbInformation
End Sub

Sub CreateFolderRecursively(folderPath As String)
    Dim subFolders As Variant
    Dim currentPath As String
    Dim i As Integer
    
    ' フォルダパスを分割
    subFolders = Split(folderPath, "\")
    
    ' ベースパスを設定
    currentPath = ""
    
    ' フォルダを順に作成
    For i = LBound(subFolders) To UBound(subFolders)
        currentPath = currentPath & subFolders(i) & "\"
        If Dir(currentPath, vbDirectory) = "" Then
            MkDir currentPath
        End If
    Next i
End Sub

説明

1.CreateFoldersマクロ:

wsで操作対象のワークシートを設定しています。lastRowでA列の最終行を取得しています。For EachループでA1から最終行までのセルを巡回し、セルの値をfolderPathに格納します。folderPathに値がある場合は、CreateFolderRecursivelyサブルーチンを呼び出してフォルダを作成します。

2.CreateFolderRecursivelyサブルーチン:

フォルダパスを「\」で分割し、各部分を順に結合してフォルダを作成します。MkDirを使用して、存在しないフォルダを作成します。このマクロをExcelのVBAエディタにコピーして実行することで、A列に指定されたフォルダパスに従ってフォルダを再帰的に作成できます。