Excel VBAでファイルを自動仕分けする方法

Excel VBAを使って、指定したルールに基づいてフォルダ内のファイルを自動的に仕分けする方法をご紹介します。この方法では、特定のファイルを指定したフォルダに移動し、移動前に確認できる仕組みを作成します。

実現すること

  • ユーザーが指定したフォルダ内のファイルを、拡張子やファイル名のルールに基づいて整理します。
  • ファイルを移動する前に、ツリービューで確認できます。
  • ルールに従って、特定のフォルダにファイルを移動します。

ステップ 1: ツリービューにファイルを表示

移動する前に、ツリービューを使用してファイルを確認できるようにします。

  • btnPreviewボタンを押すと、指定されたフォルダ内のファイルがツリービューに表示されます。
  • ツリービューには、移動前のファイルが表示され、どのファイルがどのフォルダに移動するかを確認できます。

ステップ 2: 移動するファイルを確認

ユーザーが移動先の確認をした後、移動するファイルをツリービューで色分けして表示します。

  • 移動するファイルは赤色で表示されます。
  • 移動しないファイルやスキップするファイルは灰色で表示されます。

ステップ 3: ファイルを移動

確認が終わったら、実際にファイルを移動します。ユーザーが btnMove ボタンを押すと、指定されたルールに従ってファイルが移動されます。

VBAコードの説明

以下は、この処理を実現するためのVBAコードです。

' フォルダの範囲ルールを格納する辞書
Private FolderRangeRules As Object

' 変数設定
Private ExtensionRule As String
Private NamePatternRule As String
Private SkipFolderNames As Variant

' フォームの初期化
Private Sub UserForm_Initialize()
    ' 範囲をフォルダごとに定義
    Set FolderRangeRules = CreateObject("Scripting.Dictionary")
    FolderRangeRules.Add "010", Array(0, 19)  ' 0～19 は 010 フォルダ
    FolderRangeRules.Add "020", Array(20, 29) ' 20～29 は 020 フォルダ
    FolderRangeRules.Add "bolt", Array("M00-00")  ' "M00-00"形式のファイルは bolt フォルダ

    ' その他設定
    ExtensionRule = ".prt"  ' 対象拡張子
    NamePatternRule = "assy"  ' "assy" を含むファイル名の処理
    SkipFolderNames = Array("skip1", "NoMove", "ExcludeFolder")  ' 除外するフォルダ名
End Sub

' 移動前にツリービューでファイルを表示
Private Sub DisplayFilesInTreeView()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 既存のツリービューをクリア
    TreeView1.Nodes.Clear
    TreeView2.Nodes.Clear

    Dim folderPath As String
    folderPath = TextBox1.Text  ' ユーザーが指定したフォルダパス

    ' フォルダが存在するかチェック
    If Not fso.FolderExists(folderPath) Then
        MsgBox "指定したフォルダは存在しません。"
        Exit Sub
    End If

    ' フォルダ内のファイルをツリービューに追加
    AddFilesToTreeView folderPath, TreeView1, False
End Sub

' ツリービューにファイルを追加
Private Sub AddFilesToTreeView(ByVal folderPath As String, ByRef tv As Object, ByVal isMoved As Boolean)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim folder As Object
    Set folder = fso.GetFolder(folderPath)
    
    Dim file As Object
    For Each file In folder.Files
        Dim node As Object
        Set node = tv.Nodes.Add(, , file.Path, file.Name)
        
        ' 移動前のファイルは黒色、移動後のファイルは赤色
        If isMoved Then
            node.ForeColor = vbRed
        Else
            node.ForeColor = vbBlack
        End If
    Next file
End Sub

' 移動前に確認して移動先をツリービューに表示
Private Sub PreviewMoveFiles()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 既存のツリービューをクリア
    TreeView2.Nodes.Clear

    Dim folderPath As String
    folderPath = TextBox1.Text  ' ユーザーが指定したフォルダパス

    ' フォルダが存在するかチェック
    If Not fso.FolderExists(folderPath) Then
        MsgBox "指定したフォルダは存在しません。"
        Exit Sub
    End If

    ' フォルダ内のファイルを移動後のパスに基づいてツリービューに追加
    AddFilesToTreeView folderPath, TreeView2, True
End Sub

' フォルダが存在しない場合に作成する
Private Sub EnsureFolderExists(ByVal folderPath As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folderPath) Then
        fso.CreateFolder(folderPath)
    End If
End Sub

' 移動処理
Private Sub MoveFiles()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim i As Long
    For i = 1 To TreeView2.Nodes.Count
        Dim src As String, dst As String
        src = TreeView1.Nodes(i).Text
        dst = TreeView2.Nodes(i).Text

        ' スキップ対象かチェック
        If IsInSkipFolder(src) Then
            Continue For
        End If

        ' ファイル移動処理
        If Not fso.FileExists(dst) Then
            fso.MoveFile src, dst
        End If
    Next i
End Sub

' 特定のフォルダ名がスキップ対象かチェック
Private Function IsInSkipFolder(ByVal folderName As String) As Boolean
    Dim i As Long
    For i = LBound(SkipFolderNames) To UBound(SkipFolderNames)
        If InStr(1, folderName, SkipFolderNames(i), vbTextCompare) > 0 Then
            IsInSkipFolder = True
            Exit Function
        End If
    Next i
    IsInSkipFolder = False
End Function

' ファイル名に "M00-00.prt" が含まれる場合にboltフォルダに移動
Private Function IsBoltFileName(ByVal fileName As String) As Boolean
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.IgnoreCase = True
    regEx.Global = False
    regEx.Pattern = "^M\d{2}-\d{2}\.prt$"  ' M+2桁数字-2桁数字.prt の形式
    If regEx.Test(fileName) Then
        IsBoltFileName = True
    Else
        IsBoltFileName = False
    End If
End Function

' ファイル名から番号を抽出
Private Function GetNumberFromFile(ByVal fileName As String) As Integer
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.IgnoreCase = True
    regEx.Global = False
    regEx.Pattern = "\d{4}-(\d{3})"  ' xxxx-000 の形式から000の部分を抽出
    If regEx.Test(fileName) Then
        GetNumberFromFile = CInt(regEx.Execute(fileName)(0).Submatches(0))
    Else
        GetNumberFromFile = -1
    End If
End Function

' 数字に基づいてフォルダ名を取得
Private Function GetFolderForNumber(ByVal number As Integer) As String
    Dim folderName As String
    If number >= 0 And number <= 19 Then
        folderName = "010"
    ElseIf number >= 20 And number <= 29 Then
        folderName = "020"
    ElseIf number >= 30 And number <= 39 Then
        folderName = "030"
    Else
        folderName = "etc"
    End If
    GetFolderForNumber = folderName
End Function

' ボタン1: フォルダ選択後にツリービューにファイルを表示
Private Sub btnPreview_Click()
    ' 移動前にツリービューで確認
    DisplayFilesInTreeView
    PreviewMoveFiles
End Sub

' ボタン2: ユーザーが移動ボタンを押すとファイルを実際に移動
Private Sub btnMove_Click()
    ' 実際にファイルを移動
    MoveFiles
End Sub

まとめ

このコードを使うことで、Excel VBAを使用して、指定したルールに従ってファイルを自動的に仕分けできます。ユーザーは移動前にツリービューでファイルを確認でき、移動後の状態も簡単にチェックできます。

コメント

タイトルとURLをコピーしました