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 バージョン2006″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

 

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

 

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

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

 

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

Follow me!

コメントを残す

CAPTCHA