VBAで画像を分類に応じて適切なフォルダに仕分けるプログラム

(０)目次＆概説

(１) マクロ概要
 (２) 使用方法
 (３) アルゴリズム概要
 (４) プログラム

(１) マクロ概要

本マクロは画像ファイルを適切なフォルダに仕分けるためのマクロです。前提として、正常動作には以下の情報が必要です。
①フォルダの中に格納された任意の画像ファイル

②各画像毎に「画像名」と「画像の分類」の情報をペアで保持する「リスト」

上記①に格納されている画像ファイル名について、②のリストに存在するかのチェックを行い、もしも存在する場合は、該当の分類名のフォルダに配信を行います。この処理をファイル数分、繰り返し行います。

＞目次にもどる

(２) 使用方法

(1)一時保存フォルダ(配信前フォルダ)に画像を格納します。
(2)各画像毎に「画像名」と「画像の分類」の情報をペアで保持する「リスト」の準備を行います。
　→新規シートを作成して”Distribute”と命名し、そのシート上にリストを用意します
(3)「配信開始行」と「配信終了行」の情報を付与します
　→新規シートを作成して”Controller”と命名し、そのシートの(4行,C列)に「配信開始行」を記載し、(5行,C列)に「配信終了行」を記載します。
(例)

(4) 上記が完了した状態で以下の「フォルダ配信」ボタンを押下します。
　(※ボタンを作成後「DistributeImage」メソッドをボタンに割り当てたら準備完了です)

＞目次にもどる

(３) アルゴリズム概要

(３-１) 変数定義

変数の定義は以下の通りです。

No	変数名	型	説明
1	RowStart	Integer	リストの読み込み開始行を指定
2	RowEnd	Integer	リストの読み込み終了行を指定
3	ImageName	String	リストに記載してある「画像名」（画像のファイル名）
4	ClsfResult	String	リストに記載してある「画像の分類」（画像をどのフォルダに配信するか？）
5	Dist	Worksheet	シートを指定するための変数
6	Fso	FileSystemObject	以下の用途で定義。・GetFolderメソッド・GetFolderメソッド→Subfoldersプロパティ
7	fl	Folder	フォルダでループするための変数
8	f	File	ファイルでループするための変数
9	InFolder	String	画像の入力先フォルダ
10	OutFolder	String	画像の出力先フォルダ

(３-２) 処理フロー

処理フローは以下の通りです。

Lv.	処理概要
1	リストの最初～最後までループ
2	∟”i”番目の画像の「画像名」と「分類名」を取得
3	∟INPUTフォルダ内の画像を１件ずつループ
4	∟INPUTフォルダ内の現在の画像が、リストの画像と一致しているかをチェック
5	∟画像をOUTPUTフォルダ内にある「分類名」の名前のフォルダに作成
3	∟INPUTフォルダ内のサブフォルダを１件ずつループ
4	∟INPUTフォルダ内のサブフォルダ内の画像を１件ずつループ
5	∟INPUTフォルダ内の現在の画像が、リストの画像と一致しているかをチェック
6	∟画像をOUTPUTフォルダ内にある「分類名」の名前のフォルダに作成

工夫した点としては、INPUTフォルダ直下のループと、INPUTフォルダ配下のサブフォルダのループを分けた点です。両方用意する事により、画像がINPUT直下に配置された場合でも、さらに１階層下の子フォルダに配置された場合でも配信されるようになっています。しかし、VBA初心者が組んでいるコードなので、改善点等あればご指摘頂けると嬉しいです。

＞目次にもどる

(４) プログラム

Sub DistributeImage()

    '変数定義
    Dim RowStart As Integer: RowStart = Sheets("Controller").Cells(4, 3).Value  '# 読取開始　行
    Dim RowEnd As Integer: RowEnd = Sheets("Controller").Cells(5, 3).Value      '# 読取終了　行
    
    Dim ImageName As String         '# tiffファイル名
    Dim ClsfResult As String        '# 書類分類結果
    
    Dim Fso As FileSystemObject     '# ファイル移動用のオブジェクト
    Set Fso = New FileSystemObject
       
    Dim Dist As Worksheet           '# ワークシートの変数
    Set Dist = Sheets("Distribute")
    
    Dim fl As Folder                '# フォルダの変数
    Dim f As File                   '# ファイルの変数
    
    Dim InFolder As String          '# INPUT画像のフォルダ
    InFolder = "[任意のファイルパス]\INPUT_2\"
    Dim OutFolder As String         '# OUTPUT画像のフォルダ
    OutFolder = "[任意のファイルパス]\OUTPUT\"
    
    'ForループStart
    '　○列目の○行目以降の「画像名」＆「分類」の値を順番に読む
     For i = RowStart To RowEnd
    
        '「画像名」および「分類」の値を取得
        ImageName = Dist.Cells(i, 1)
        ClsfResult = Dist.Cells(i, 2)
        Debug.Print "Distributeリストの　" & i & "番目のImageName: " & ImageName & " , ClsfResult: " & ClsfResult
       
            'INPUTフォルダのサブフォルダ内にある全ファイルを一つずつチェックする
            For Each f In Fso.GetFolder(InFolder).Files
                Debug.Print "　∟探索 フォルダ名: " & Fso.GetFolder(InFolder).Name
                Debug.Print "　　∟探索 画像名：　" & f

                'INPUTフォルダ内の画像とリストの画像名が一致しているかチェックする
                If f.Name = ImageName Then
                    Call f.Copy(OutFolder & ClsfResult & "\" & ClsfResult & "_" & ImageName)
                    Debug.Print "　　　∟Distributeリストの　" & i & "番目の画像でフォルダ内画像と「一致」が発見されました。コピー先は: " & OutFolder & ClsfResult & "\" & ClsfResult & "_" & ImageName
                End If
            Next
       
       
        'INPUTフォルダ内のサブフォルダを順番にチェックする
        For Each fl In Fso.GetFolder(InFolder).SubFolders

            Debug.Print "　∟探索 サブフォルダ名: " & fl

            'INPUTフォルダのサブフォルダ内にある全ファイルを一つずつチェックする
            For Each f In fl.Files

                Debug.Print "　　∟探索 画像名：　" & f

                'サブフォルダ内の画像とリストの画像名が一致しているかチェックする
                If f.Name = ImageName Then
                    Call f.Copy(OutFolder & ClsfResult & "\" & ClsfResult & "_" & ImageName)
                    Debug.Print "　　　∟Distributeリストの　" & i & "番目の画像でフォルダ内画像と「一致」が発見されました。コピー先は: " & OutFolder & ClsfResult & "\" & ClsfResult & "_" & ImageName
                End If
            Next
        Next

    'ForループEnd
    Next i
    
    'ファイルシステムオブジェクトの後処理
    Set Fso = Nothing

End Sub

＞目次にもどる