習志野コンペの写真分類

21時過ぎに自宅に帰りついて、習志野のコンペの4000枚の写真の分類に着手
選手ごとに出場クラス+ゼッケン番号でフォルダを作成して、その中にそれぞれ分類していく
フォルダを一つ一つ作成するのがとても面倒なのでVBAで簡単なアプリを作った
今夜はこのアプリを作っておしまいだ

Sub フォルダ作成()

'指定したフォルダがなければ新規作成する
    Dim シート1 As Variant
    Set シート1 = ThisWorkbook.Worksheets(1) 'シート1をオブジェクト変数化
    Dim SaveDir As String
    Dim FolderName As String
    FolderName = シート1.Range("B4").Value



    Dim 連番 As String
    Dim 開始 As Integer '開始連番
    Dim 最終 As Integer '最終連番
    開始 = シート1.Range("B6").Value '開始連番を代入
    最終 = シート1.Range("D6").Value '最終連番を代入

    Dim ディレクトリ As String
    ディレクトリ = シート1.Range("B2").Value
 
    If MsgBox("保存場所「" & ディレクトリ & "」" & vbCrLf & "フォルダ名「" & FolderName & "」" & vbCrLf & "連番　" & 開始 & "から" & 最終 & "まで" & vbCrLf & "この内容でフォルダを作成してよろしいですか？", vbYesNo, "フォルダ作成の確認") = vbNo Then
       Exit Sub
    End If
 
    Dim i As Integer '連番用カウンタ変数
    For i = 開始 To 最終
        連番 = Right("00" & i, 3)
        SaveDir = シート1.Range("B2") & FolderName & 連番 '保存先フォルダ名の定義
     
        If Dir(SaveDir, vbDirectory) = "" Then '定義した保存先フォルダ名が存在しなければ
            MkDir SaveDir '保存用フォルダを作成する
        End If
    Next

End Sub