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


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