「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



