Sub CreateFoldersAndSubfolders()
Dim basePath As String
Dim mainFolderName As String
Dim mainFolderPath As String
Dim subFolderName As String
Dim i As Integer
' ベースパスを設定
basePath = "Z:\"
' メインフォルダの名前をセル AL1 から取得
mainFolderName = Range("AL1").Value
' メインフォルダ名が空でないことを確認
If mainFolderName <> "" Then
mainFolderPath = basePath & mainFolderName
' メインフォルダを作成
MkDir mainFolderPath
' メインフォルダ内にサブフォルダを作成
For i = 2 To 21
subFolderName = Range("U" & i).Value
If subFolderName <> "" Then
MkDir mainFolderPath & "\" & subFolderName
End If
Next i
MsgBox "新しいフォルダとサブフォルダが作成されました。", vbInformation
Else
MsgBox "AL1セルにメインフォルダ名を入力してください。", vbExclamation
End If
End Sub