Excel VBA ファイル自動振り分けマクロ(コピペで使える便利機能)

 

日常業務を行うにあたって、たくさんあるファイルをいくつかのフォルダへ自動で簡単に振り分けることができたら良いと思います。

 

その際にエクセルの表で記載したフォルダパスへファイルを自動で振り分けることができたら良いなと考え(記事を見て頂いた方からコメントを頂きました)、ファイル振り分けを自動的に行うマクロを作成しましたのでご活用頂けたらと思います。

 

このファイル自動振り分けマクロは、過去にアップした便利マクロフォルダ自動作成マクロを用いて振り分けるフォルダを自動生成した後に使用すると良いと思います。

 

ファイル自動振り分けマクロの概要

エクセルに振り分け先のフォルダ名と、振り分けるファイル名を記入してマクロを実行すると、指定したパスのフォルダにファイルを自動で振り分けされます。

 

ExcelにてVBAコードよりマクロを作成し、ボタン(図形にて作成)をクリックすることでマクロを実行させてファイル振り分け処理を実施します。

 

何ができるマクロなのか?

1.ファイル自動振り分けマクロのVBAコードを含んだExcelファイル(***.xlsm)を任意のフォルダに保存して、そのExcelファイルを開きます。

 

2.開いたExcelファイルにどのフォルダに振り分けるかのフォルダ名と振り分けるファイル名を記入します。

このファイル自動振り分けマクロがあるフォルダの階層が「フォルダ1」と同階層となります。

記入するフォルダ名の階層等のルールはフォルダ自動作成マクロと同様ですので、参考にして下さい。

 

3.フォルダ名とファイル名を記入し、図形を押してマクロを実行します。

表示されたダイアログで振り分けるファイルが格納されたフォルダを指定します。

 

4.2で指定したフォルダへ指定したファイルが振り分けられています。

※振り分けたファイルは元々格納されていたフォルダからは削除されています。

 

5.下階層のフォルダにも同じくファイルが振り分けられました。

 

フォルダ自動作成マクロの使用方法

1.Excelを開き、「開発」タブをクリックして、「Visial Basic」をクリックします。

 

2.「Microsoft Excel Object」にて右クリックして、「挿入」→「標準モジュール」をクリックします。

 

3.右側の空欄スペースに下記のVBAコードをコピペで入力します。

Option Explicit

'振り分けるファイルが格納されたフォルダのパス
Public ImportDir As String

'エラーの有無
Public BlnErrFlg As Boolean

Sub file_sorting_main()
    
    On Error GoTo err
    
    Call initialize
    Call folderSelect
    Call fileSorting
    
    If BlnErrFlg Then
        MsgBox "赤色で表示された箇所は、下記により正しくファイルを振り分けることができませんでした。" & vbCrLf & vbCrLf _
        & "フォルダ名:指定されたフォルダ名は存在していません。 " & vbCrLf _
        & "ファイル名:ダイアログで選択したフォルダ内にファイルが存在しないか、振り分け先に同一名称のファイルが存在しています。"
    Else
        MsgBox "ファイル振り分け処理が正常に実行されました"
    End If
    
    Exit Sub
err:
    MsgBox "予期せぬエラーが発生しました、ツール利用ルールを確認してもう一度実行してください。"
    
End Sub

'-------------------------------------
'色の変更、初期化等を行う
'-------------------------------------
Sub initialize()

    Dim endRange As Range
    
    '表の最終行番号と列番号を取得する
    Set endRange = ActiveSheet.Range("A2").SpecialCells(xlLastCell)
    
    '表全体の文字色を黒色に変更する
    Range(Cells(2, 1), Cells(endRange.row, endRange.Column)).Font.ColorIndex = 1
    
    BlnErrFlg = False
    
End Sub

'-------------------------------------
'振り分けるファイルが入っているフォルダを選択する
'-------------------------------------
Sub folderSelect()
    
    'フォルダ選択ダイアログを表示させる
    With Application.FileDialog(msoFileDialogFolderPicker)
    
        .Title = "振り分けるファイルが入っているフォルダを選択してください。"
        
        If .Show <> 0 Then
            ImportDir = .SelectedItems(1)
        Else
            End
        End If
    
    End With

End Sub

'-------------------------------------
'ファイル振り分けの処理を行う
'-------------------------------------
Sub fileSorting()

    Dim row As Long
    Dim col As Long
    Dim colFolder As Long
    Dim colFile As Long
    
    Dim folderNm As String
    Dim folderPath As String
    Dim fileNm As String
    
    Dim layerNm1 As String
    Dim layerNm2 As String
    Dim layerNm3 As String
    Dim layerNm4 As String
    Dim layerNm5 As String
    
    'フォルダ名称、ファイル名称が記載されている行数分だけ繰り返す
    For row = 2 To Range("A1").SpecialCells(xlCellTypeLastCell).row
        
        'フォルダ名称、ファイル名称が記載されている列数分だけ繰り返す
        For col = 1 To 5
            
            'フォルダ名称が入っている列番号
            colFolder = col * 2 - 1
            
            'ファイル名称が入っている列番号
            colFile = col * 2
            
            folderNm = Cells(row, colFolder)
            fileNm = Cells(row, colFile)
            
            'ファイル名に値が入っている場合
            If fileNm <> "" Then
            
                'フォルダ名に値が入っている場合
                If folderNm <> "" Then
                    
                    Select Case col
                        Case 1
                            layerNm1 = Cells(row, colFolder)
                            folderPath = folderNm
                        Case 2
                            layerNm2 = Cells(row, colFolder)
                            folderPath = "\" & layerNm1 & "\" & folderNm
                        Case 3
                            layerNm3 = Cells(row, colFolder)
                            folderPath = "\" & layerNm1 & "\" & layerNm2 & "\" & folderNm
                        Case 4
                            layerNm4 = Cells(row, colFolder)
                            folderPath = "\" & layerNm1 & "\" & layerNm2 & "\" & layerNm3 & "\" & folderNm
                        Case 5
                            layerNm5 = Cells(row, colFolder)
                            folderPath = "\" & layerNm1 & "\" & layerNm2 & "\" & layerNm3 & "\" & layerNm4 & "\" & folderNm
                    End Select
                
                End If
                
                '指定されたフォルダが存在しない場合はエラーとする
                If Dir(ThisWorkbook.Path & "\" & folderPath, vbDirectory) = "" Then
                    Cells(row, colFolder).Font.ColorIndex = 3
                    BlnErrFlg = True
                    Exit For
                End If
                
                fileNm = Dir(ImportDir & "\" & fileNm & ".*")
                
                '指定されたファイル名が存在しない場合、または既にファイルが存在する場合はエラーとする
                If fileNm = "" Or Dir(ThisWorkbook.Path & "\" & folderPath & "\" & fileNm) <> "" Then
                    Cells(row, colFile).Font.ColorIndex = 3
                    BlnErrFlg = True
                Else
                        'ファイルを移動する(パスとファイル名称変更をする)
                        Name ImportDir & "\" & fileNm As ThisWorkbook.Path & "\" & folderPath & "\" & fileNm
                End If
                
                Exit For
            End If
        Next col
    Next row
End Sub

 

4.ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。

 

5.Excelシートに戻り2行目から下に振り分け先フォルダ名と振り分けるファイル名を記入します。

(1行目はタイトル行として扱っているため、1行目の値は無視されます)

 

6.上部メニューの「挿入」タブ→「図形」→「四角形」を選択して、シート内に図形(四角形以外でも良いです)を作成します。

 6は当記事の一番下のエクセルファイルをダウンロードして使用する場合は不要です。

 

7.6で作成した図形にメイン処理「file_sorting_main」のマクロを設定します。

 

8.7でマクロ登録した図形にカーソルを当てて、指の形になっているのを確認してクリックします。

 

このマクロを使う上での注意点

当マクロを使用するにあたって、指定するフォルダ名称の記入位置などのルールがありますので、以下を確認してください。

 

フォルダ名称の記入ルール

奇数列に関しては、「フォルダ自動作成マクロ」のルールと同様です。

 

奇数列にはフォルダ名称、偶数列にはファイル名称を記入する

(注意)A列、C列、E列、G列、I列にはフォルダ名称を記入し、B列、D列、F列、H列、J列にはファイル名称を記入してください。

一番左の列(A列の2行目)に最初のフォルダ名を記入してください。

 

一つの行に複数のフォルダ名等の指定をしない

(注意)1行で記入できるセルは一つだけです。

 

存在するフォルダと存在するファイルを指定する

指定するフォルダは、既に存在するフォルダの名称と階層を記入してください。

※当マクロにはフォルダを自動生成する機能はありません。

指定するファイルは、振り分けるフォルダ内に存在するファイルを記入して下さい。

 

上記のルールを守っていない行は、ファイル自動振り分けの対象から外れます。

その場合、誤っている箇所を赤色で表示させ、当該行の処理はスキップされます。

 

また、実行後に指定したフォルダが全て作成されたか、誤ったフォルダ指定をした箇所があるか、どちらかのメッセージが表示されますので確認してください。

 

なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

 

正常に動作しない場合は、コメントいただければ幸いです。

 

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

サンプルのダウンロードはこちら

 ファイル自動振り分けマクロのツール本体

 

上記よりダウンロードして、VBAコードを組み込んでマクロを使用してください。
※マクロをインターネットからダウンロードするのはリスクを伴うと思いますので、マクロ入りでなくエクセル形式でアップロードしています。

Follow me!

Excel VBA ファイル自動振り分けマクロ(コピペで使える便利機能)” に対して12件のコメントがあります。

  1. 茶々 より:

    こんにちは。
    ファイル自動振り分けのマクロを活用させていただいております。
    一つ質問をさせて下さい。

    フォルダ1→フォルダ2→フォルダ3というフォルダ1の中に2階層のフォルダが有り、フォルダ2にファイルA、フォルダ3にファイルBを振分けようとしましたが、うまく行きませんでした。
    フォルダ1にファイルA、フォルダ2にファイルBの振分けは出来ましたので、第1階層のフォルダには必ずファイルを割り当てないと振り分けは出来ないのでしょうか?
    第1階層のフォルダに振り分けずにその中のサブフォルダにファイルを振分けしたいと思っております。

    お手数ですが、振分け方法をご教授いただければと思います。
    宜しくお願い致します。

    1. RH より:

      管理人のRHです。

      当ツールをお使い頂き、また併せて問題をご報告いただき、ありがとうございます。

      確かにおっしゃる通り、第1階層のフォルダには必ずファイルを割り当てないと振り分けができない仕様となっております。恐れ入ります、気が付きませんでした。

      目的を達成するための別の案として、以下の状態で実行してみるとうまくいきますでしょうか。
      1.この自動振り分けマクロのファイルを「フォルダ2」と同階層に配置する。
      2.A2セルには「フォルダ2」を記入し、C列に「フォルダ3」を記入する。
        ※ファイルAはB列、ファイルBはD列となります。

      1. 茶々 より:

        返信ありがとうございます。
        説明不足で申し訳ございませんが、以下の使い方を想定しているのでご提案いただいた方法だとちょっと難しいと思います。

        ・フォルダ1→フォルダ2→フォルダ3のフォルダ2にファイルA、フォルダ3にファイルBを振り分けるというのがフォルダ違いで100パターン程有り、それを同時に処理したいと考えています。
        ・フォルダ1にファイルを振り分ける事も有るが、フォルダ1には振り分けずその中のサブフォルダのみにファイルを振り分ける使い方も有る

        試しにA2セルにフォルダ1、B2セルにダミーのファイル名、C3にフォルダ2、D3にファイルA、E4にフォルダ3、F4にファイルBを入れて実行するとB2セルは当然赤字でエラーになりましたが、フォルダ2、3にファイルの振分けをする事が出来ました。
        このやり方で使おうと思いますが、他に良い方法があれば教えていただけないでしょうか?

        お手数をお掛けしますが、宜しくお願い致します。

        1. RH より:

          管理人のRHです。
          そうでしたか、誤った解釈しておりました申し訳ありませんでした。

          このツールの現状の作りでは、茶々様の言う通りB2にダミーファイル(存在しないファイル)を設定して動かすとそこをスキップして動作するので、ひとまずその方法での使用をお願いします。

          そのような使い方があったとは考えが足りなかったです。B2にファイル指定がない場合でも動くように修正致します。

          1. 茶々 より:

            コメント、ありがとうございます。
            他の質問もありますので新たにコメントさせていただきます

  2. ぽぽぽん より:

    はじめまして。
    ファイルの自動振り分けの検索でこちらにたどり着きました。
    大変参考になります。

    使用してみてエラーというかうまくできない箇所がありましたのでご質問いたします。
    ファイル名で文字数の制限か、規則の制限はありますでしょうか?
    例えば、
    ①a_【asdko1010_10】【見積書】_相手先様_自分の名前
    上記のようなファイル名の場合、”【見積書】”の箇所までのファイル名は振り分けをしてくれるのですが、フルのファイル名だと振り分けのエラーがでてしまいます。
    すみかっこが原因なのか文字数の問題なのかなにか対策ありましたら教えていただけますと幸いです。
    (ファイルの文字数をカウントしたところ59文字前後になりました。)

  3. ぽぽぽん より:

    何度も申し訳ございません。
    先ほど質問させていただいたものです。

    ファイル名は何個試行錯誤してわかったのですが、
    どうやらファイル名のカタカナの濁音に問題があったようです。
    “ジ”が、シと゛に分かれていたのがエラーを起こしてしまう問題のようです。
    カタカナ部分を書き換えたところ無事読込できました。
    お手数おかけして申し訳ありません。
    ありがとうございました。

  4. RH より:

    管理人のRHです。
    当ツールをお使い頂き、ありがとうございます。

    ぽぽぽん様、無事マクロを実行できたということで安心しました、また何かありましたらコメントをお願いします。

  5. 茶々 より:

    度々のコメントで申し訳ございません。
    本ツールではフォルダの振分けは出来ないと思いますが、コードを一部変更してフォルダの振分けをする事は可能でしょうか?
    対応可能な場合、変更内容をご教授いただければと思います。

    マクロ、VBAの知識が無い為、大まかな質問になり申し訳ございませんが、宜しくお願い致します。

    1. RH より:

      管理人のRHです。
      ご質問頂き、ありがとうございます。ご返答が遅くなりました。

      暫定的な対策として、フォルダを振り分けることも可能です。
      その場合は、136行目の「fileNm = Dir(ImportDir & “\” & fileNm & “.*”)」をコメントアウト(先頭に [‘] シングルコーテーションを付ける)していただければひとまずは正常にフォルダを振り分けることができます。

      しかし、136行目をコメントアウトした場合、通常の使い方であるファイルの振り分けを行うことができませんので、ご注意ください。

      >本ツールではフォルダの振分けは出来ないと思いますが、コードを一部変更してフォルダの振分けをする事は可能でしょうか?
      >対応可能な場合、変更内容をご教授いただければと思います。

      後日、改めてファイルとフォルダの両方を振り分け可能なコードを記載したいと思います。

      1. 茶々 より:

        回答ありがとうございます。
        教えていただいた暫定対策で無事フォルダの振分けが出来ました。
        多くのフォルダを扱うので、本当に助かりました。

        1. RH より:

          管理人のRHです。
          いえ、無事目的が達成されたとのことでよかったです。

          また何か作業効率化において必要な機能等がありましたら、ファイル自動振り分けツールとは関係ないものでも良いので、ご要望いただければと思います。

コメントを残す

CAPTCHA