Rainbow Planet (GT×IT×SP×SA)

IT技術を分かりやすく簡潔にまとめることによる学習の効率化、また日常の気付きを記録に残すことを目指します。

01_IT技術 (Technology)

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

投稿日:2019年5月26日 更新日:

(0)目次&概説

(1) マクロ概要
(2) 使用方法
(3) アルゴリズム概要
(4) プログラム

(1) マクロ概要

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

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

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

目次にもどる

(2) 使用方法

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

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

目次にもどる

(3) アルゴリズム概要

(3-1) 変数定義

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

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 画像の出力先フォルダ

(3-2) 処理フロー

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

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

 

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

目次にもどる

(4) プログラム

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

目次にもどる

Adsense審査用広告コード


Adsense審査用広告コード


-01_IT技術 (Technology)

執筆者:


comment

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

関連記事

Linuxサーバ(CentOS6)にOracleDB11gをインストールする(その1)

掲題の通り、LinuxにOracleDB(11g)をインストールする方法について書きます。 ■目次 (0)前提条件 (1)インストール要件の確認 (2)ユーザ/グループ作成 (3)Oracle DBソ …

最新テクノロジーを使ったデジタルアート!豊洲のチームラボプラネッツのご紹介【体験レポ】

(0)目次&概説 (1) チームラボとは (2) チームラボ プラネッツ  (2-1) 概要  (2-2) 坂の上にある光の滝  (2-3) やわらかいブラックホール  (2-4) The Infin …

scpコマンドを使った異なるLinuxサーバ間のファイル転送の方法

異なるLinuxサーバ間(サーバA⇔サーバB)でファイルを転送する方法について書きます。 (0)目次&概説 >(1) 転送コマンドの構文 >(2) 転送コマンドの実行  >(2-1) 転送元の転送前( …

ORA-00257エラーの対応(“archiver error. Connect Internal only. until freed”)

ORA-00257エラーの対応法についてです。 (“archiver error. Connect Internal only, until freed”) (0) 目次 (1 …

Oracleデータベースのインデックスの有無による速度の差異を検証する

(0)目次&概説 (1) 検証概要 (2) 検証環境 (3) 検証準備  (3-1) サンプルデータ作成(インデックス無)  (3-2) サンプルデータ作成(インデックス有)  (3-3) 実行計画の …

Top