「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