2017年4月4日火曜日

習志野コンペの写真分類


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

2 件のコメント:

中田高成 さんのコメント...

こんにちは��
この大会に家族その他で出場した中田ともうします。カクさんの撮影された写真をいただければと思うのですが可能ですか?
よろしくお願いします。
poccolo11c@gmail.com

Motoaki Kaku さんのコメント...

ご本人やご家族の方であれば可能です
右下の連絡フォームを利用して、出場クラスとゼッケン番号をお知らせください

コメントを投稿