連番フォルダ自動作成

目次

メインモジュール・コード


Option Explicit
Sub メイン()

formメニュー.Show

End Sub

Sub フォルダ作成(ByVal rngList As Range, Optional ByVal tgtFolder As String = "")

If tgtFolder = "\" Then Exit Sub    'フォルダ選択がされていない場合(¥のみ)は何もしないで終了

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim myRng As Variant
Dim tgtFullName As String

On Error Resume Next
For Each myRng In rngList
    If myRng.Value <> "" Then
        tgtFullName = tgtFolder & myRng.Value
        FSO.CreateFolder (tgtFullName)
    End If
Next myRng

Set FSO = Nothing

'エラー表示
Call エラー表示("フォルダ作成完了")
End Sub

Sub フォルダ削除(ByVal rngList As Range, Optional ByVal tgtFolder As String = "")

If tgtFolder = "\" Then Exit Sub    'フォルダ選択がされていない場合(¥のみ)は何もしないで終了

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim myRng As Variant

On Error Resume Next
For Each myRng In rngList
    If myRng.Value <> "" Then
        FSO.DeleteFolder (tgtFolder & myRng.Value)
    End If
Next myRng

Set FSO = Nothing

'エラー表示
Call エラー表示("フォルダ削除完了")
End Sub

Function フォルダ選択()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .AllowMultiSelect = False
        .Title = "フォルダの選択"
        If .Show = True Then
            フォルダ選択 = .SelectedItems(1)
        Else
            MsgBox "選択されていません"
            フォルダ選択 = ""
        End If
    End With
End Function

Sub エラー表示(Optional ByVal myMsg As String)

If Err.Number <> 0 Then
    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation
Else
    MsgBox myMsg
End If

End Sub

ユーザフォーム・コード


Option Explicit

Private Sub btn終了_Click()

Unload formメニュー

End Sub

Private Sub btn実行_Click()

Dim rngList As Range
Set rngList = Range(Range("C2"), Range("C2").End(xlDown))

Select Case cmbメニュー.Text

    Case "フォルダ作成"
        Call フォルダ作成(rngList, フォルダ選択() & "\")

    Case "フォルダ削除"
        Call フォルダ削除(rngList, フォルダ選択() & "\")

    Case Else
        MsgBox "機能が選択されていません。"
    Exit Sub
End Select

End Sub

Private Sub UserForm_Initialize()

    With cmbメニュー
    .AddItem "フォルダ作成"
    .AddItem "フォルダ削除"
    End With

End Sub

解説

【説明】
C列の名称で空のフォルダを作成(または削除)する。
リストに追記することで追加することも可能(ただし空白を含まないようにする)。
ツールダウンロード