連続番号の複数フォルダを作成する


「001」「002」という連続番号のサブフォルダを、指定した数だけ作成します。作成する親フォルダはC:\Workです。存在しないときはメッセージを表示して処理を中止します。開始番号と終了番号のいずれかで[キャンセル]ボタンがクリックされると処理を中止します。すでに同名のフォルダがある場合はCreateFolderメソッドがエラーになりますが、無視して処理を続けています。

Sub Sample03()
    Dim FSO As Object, StartNum As Long, EndNum As Long, i As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ''C:\Workフォルダの存在を調べます
    If FSO.FolderExists("C:\Work\") = False Then
        MsgBox "C:\Workフォルダを作ってから実行してください", vbExclamation
        Set FSO = Nothing
        Exit Sub
    End If
    ''開始数字と終了数字をユーザーから受け取ります
    StartNum = Val(InputBox("連続番号フォルダの開始番号は?"))
    EndNum = Val(InputBox("連続番号フォルダの終了番号は?"))
    If StartNum = 0 Or EndNum = 0 Then Exit Sub
    ''連続番号フォルダを作成します
    ''同名フォルダが存在する場合のエラーを無視します
    On Error Resume Next
    For i = StartNum To EndNum
        FSO.CreateFolder "C:\Work\" & Format(i, "000")
    Next i
    MsgBox Format(StartNum, "000") & "から" & _
           Format(EndNum, "000") & "のフォルダを作成しました", vbInformation
    Set FSO = Nothing
End Sub