概要
このVBAコードは、指定したフォルダ内のファイルを自動で分類して移動し、その結果を2次元配列に格納する機能を提供します。
主な機能
- ファイルの分類: ファイル名の数字部分を基に10の倍数ごとにフォルダを作成し、ファイルを整理。
- 重複ファイルの処理: 同じ名前のファイルがあれば「コピーできません」フォルダに移動し、ファイル名を自動で変更。
- 結果出力: 元のファイルパスと新しいファイルパスを2次元配列に格納し、整理結果を出力。
使い方の流れ
このコードは以下のステップでファイルを分類・移動します。
- ファイル選択ダイアログを使って、ユーザーが移動したいファイルを選択します。
- ファイル名の数字部分（例:
10-ファイル名.txt）を元に、10の倍数ごとにフォルダを作成してファイルを分類します。 - 同じ名前のファイルがある場合、そのファイルは「コピーできません」という専用フォルダに移動し、ファイル名にアルファベットを付けて重複を回避します。
- 最終的に、元のファイルパスと新しいファイルパスを2次元配列で返します。
サンプルコード
メイン処理: ファイル分類と移動
以下のVBAコードを使用して、ファイルの分類と移動を行います。
Function ClassifyAndMoveFiles2D(filePaths As Variant, parentFolder As String) As Variant
' FileSystemObjectを作成し、ファイル操作を行う
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
' ファイル名の重複を防ぐためのディクショナリ
Dim usedNames As Object
Set usedNames = CreateObject("Scripting.Dictionary")
' 重複ファイルを保存する「コピーできません」フォルダのパス
Dim duplicateFolder As String
duplicateFolder = fso.BuildPath(parentFolder, "コピーできません")
' 結果を格納する2次元配列（元のパスと新しいパス）
Dim results() As String
ReDim results(1 To UBound(filePaths) - LBound(filePaths) + 1, 1 To 2)
' 各ファイルを処理
Dim i As Long
For i = LBound(filePaths) To UBound(filePaths)
Dim srcPath As String
srcPath = filePaths(i)
results(i - LBound(filePaths) + 1, 1) = srcPath
' ファイルが存在しない場合
If Not fso.FileExists(srcPath) Then
results(i - LBound(filePaths) + 1, 2) = "ファイルが存在しません"
GoTo ContinueLoop ' 次のファイルへ
End If
' ファイル名を取得
Dim fileName As String
fileName = fso.GetFileName(srcPath)
' ファイル名を基に分類
Dim baseName As String
baseName = fso.GetBaseName(fileName)
Dim folderName As String
Dim matched As Boolean
matched = False
If baseName Like "*-*" Then ' 数字-名前の形式
Dim dashPos As Long
dashPos = InStr(baseName, "-")
If IsNumeric(Left(baseName, dashPos - 1)) Then
Dim numPart As Long
numPart = CLng(Left(baseName, dashPos - 1))
folderName = "Group_" & (numPart \ 10) * 10 ' 10の倍数ごとにフォルダ名作成
matched = True
End If
End If
' 形式に合わない場合は「その他」フォルダに
If Not matched Then folderName = "その他"
' 新しいフォルダパスを作成
Dim destFolder As String
destFolder = fso.BuildPath(parentFolder, folderName)
If Not fso.FolderExists(destFolder) Then fso.CreateFolder destFolder
' 新しいファイルパスを作成
Dim newFilePath As String
newFilePath = fso.BuildPath(destFolder, fileName)
' 同名のファイルがあるか確認
If Not usedNames.exists(destFolder & "\" & fileName) Then
usedNames.Add destFolder & "\" & fileName, 1
Else
' 重複の場合、「コピーできません」フォルダに移動
If Not fso.FolderExists(duplicateFolder) Then fso.CreateFolder(duplicateFolder)
newFilePath = fso.BuildPath(duplicateFolder, "【同一名】" & fileName)
End If
' ファイルを移動
fso.MoveFile srcPath, newFilePath
results(i - LBound(filePaths) + 1, 2) = newFilePath
ContinueLoop:
Next i
' 2次元配列で結果を返す
ClassifyAndMoveFiles2D = results
End Function
ファイル分類の例
例えば、以下のようなファイル名があった場合：
このように、ファイル名に含まれる数字部分を利用して、10ごとのフォルダ（Group_0, Group_10, Group_20など）に分類します。
重複ファイルの処理
同じ名前のファイルがあった場合、次のように処理されます。
同名のファイルが見つかると、「コピーできません」というフォルダに移動し、ファイル名に「【同一名A】」などを付けて重複を回避します。
使用例
このコードを使うと、簡単にファイルを整理できます。ファイルを選択した後、処理結果を2次元配列で返すので、整理後のファイルパスを確認することができます。
Sub Test分類処理()
Dim files As Variant
files = SelectMultipleFiles() ' 複数ファイル選択ダイアログ
Dim parentFolder As String
parentFolder = "C:\整理済みフォルダ" ' 整理先の親フォルダ
' ファイルを分類して移動
Dim results As Variant
results = ClassifyAndMoveFiles2D(files, parentFolder)
' 結果をデバッグウィンドウに表示
Dim i As Long
For i = LBound(results, 1) To UBound(results, 1)
Debug.Print "元のパス: " & results(i, 1)
Debug.Print "新しいパス: " & results(i, 2)
Next i
End Sub
まとめ
このVBAコードは、ファイルを数字や形式に基づいて分類し、重複ファイルを自動的に処理する強力なツールです。手動で行っていたファイル整理を効率的に行い、作業時間を短縮できます。
コメント