'2行目以降に作成したい空フォルダー名を記入する。

'このシート(どの空白セルでも可）をダブルクリックすると同じフォルダーに記入した空フォルダーが自動的に作成される。同じ名前のフォルダー名が既に存在するとエラーとなる。

'(空白セルで停止)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim AA As String

ss = ThisWorkbook.Path 'このファイルの親フォルダー

n = 1

Do

n = n + 1

AA = Worksheets("Sheet1").Cells(n, 1)

' // Empty か "" をチェックする。

If IsEmpty(AA) Or Trim(AA) = "" Then Exit Do

MkDir (ss & "\" & AA)

Loop

Exit Sub

End Sub

備忘録