サンプル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