サンプル3「連続番号の複数フォルダを作成する」の続きみたいなもんです。
「001」「002」という連続番号のサブフォルダが存在するとき、次の番号のサブフォルダを1つ作成します。
Sub Sample04()
Dim FSO As Object, LargeNum As Long, Fil As Variant
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
''C:\Work内の全てのサブフォルダから最大番号を調べます
For Each Fil In FSO.GetFolder("C:\Work\").SubFolders
If LargeNum < Val(Fil.Name) Then LargeNum = Val(Fil.Name)
Next Fil
FSO.Createfolder "C:\Work\" & Format(LargeNum + 1, "000")
MsgBox Format(LargeNum + 1, "000") & "フォルダを作成しました", vbInformation
Set FSO = Nothing
End Sub

