はじめに（ツール作成のきっかけ）
職場の共有フォルダがごちゃついており、どのファイルがどこにあるのか分かりづらい状況でした。Windowsのフォルダ内検索機能で検索しても、ファイル数が多く、時間がかかっていました。また、セキュリティの観点から、フリーソフトをインストールすることが難しい状況。。。
そこで、ExcelのVBAを使用して、共有フォルダ内のファイルを簡単に検索できるツールを作成することにしました。
ツールデモ
以下がツール（ファイルコンパス）のデモ動画です。
ツールの説明
外観
概要
ファイルコンパスは、ExcelのVBAを利用し、指定されたフォルダ内のファイル情報を取得して、Excelのワークシートに書き込み、ファイルを簡単に検索できるツールです。例えば、あるフォルダ内にたくさんのファイルがあり、そのファイルの名前や作成日時、ファイルの保存先（パス）などの情報をExcelのワークシートに読み込み、検索することができます。 また、ファイルサイズも取得するため、共有フォルダの容量を圧迫しているデータサイズの大きなファイルを把握する用途としても便利です。
ファイル情報抽出機能
「ファイル情報を抽出」ボタンをクリックすると、まずフォルダを指定する画面が表示されます。フォルダを指定すると、そのフォルダ内の全てのファイルを検索し、ファイルの名前、作成日時、更新日時、ファイルサイズおよびファイルの保存場所（パス）を取得します。そして、その情報をExcelのワークシートに書き込みます。 プログラムを実行すると、ステータスバーに進捗状況が表示され、完了したらハイパーリンクが付いたExcelのファイルが作成されます。 ※ハイパーリンクはマクロで上手く有効にすることができなかったので、HYPERLINK関数を用いています(;^ω^)
ファイル検索機能
「検索」ボタンをクリックすると、検索フォームが表示され、複数のワードでファイルを検索することができます。 ※たぶん、「Ctrl + F」より高速に検索できるはず(;^ω^)
作り方
ツールの外観の作成についての説明は割愛します。 以下VBAのコード及びユーザーフォームについて説明をします。
コード一覧
3つの標準モジュール（Module1、Module2、Module3）と1つのフォーム（UserForm1）で構成されています。
Module1（初期化プログラム）
ファイル内の情報を初期化するマクロです。
Sub 初期化() ' 初期化ボタンがクリックされたときに実行されるマクロです。 ' 「本当に初期化してもよろしいですか？」の確認ダイアログを表示し、ユーザーの回答によって処理を決定します。 ' 確認ダイアログを表示し、ボタンの選択結果を変数resultに格納します。 Dim result As VbMsgBoxResult result = MsgBox("本当に初期化してもよろしいですか？", vbYesNo, "確認") ' ユーザーがYesボタンを選択した場合、データを初期化します。 If result = vbYes Then Range("A5:E1048576,C3").Select Selection.ClearContents ' 選択範囲の値を削除します。 Range("B1").Select End If End Sub
Module2（ファイル情報取得プログラム）
フォルダ内のファイル情報を取得するマクロです。
Sub GetFilesAndFoldersInfo() ' ファイルの情報を取得するマクロです。 ' サブフォルダを含むフォルダ内のファイル情報を取得して、ワークシートに書き込みます。 Dim objFSO As Object ' FileSystemObject を格納する変数 Dim objFolder As Object ' フォルダを格納する変数 Dim objSubFolder As Object ' サブフォルダを格納する変数 Dim objFile As Object ' ファイルを格納する変数 Dim i As Long ' 出力行を指定する変数 Dim sharePath As String ' フォルダのパスを格納する変数 Dim topRow As Long ' データの出力先の行番号を格納する変数 Dim totalCount As Long ' ファイルの総数を格納する変数 Dim count As Long ' 取得したファイルの件数を格納する変数 ' ファイルパスを入力するダイアログボックスを表示 sharePath = InputBox("抽出したいフォルダのパスを入力してください。", "パスの入力画面") If sharePath = "" Then ' キャンセルをクリックした場合は何もせず終了する Exit Sub End If Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(sharePath) ' ファイル総数を再帰的に検索 totalCount = CountFilesInFolder(objFolder) ' メッセージボックスでファイル総数と見積もり時間を表示し、処理続行の確認を取得 Dim timeEstimate As String Dim confirmMsg As String timeEstimate = Format((totalCount / 100), "#0.0") ' 簡易的な見積もり。 confirmMsg = "ファイル総数は " & totalCount & " 件のため、抽出には約 " & timeEstimate & " 分かかります。" & vbCrLf & "処理を続けますか？" If MsgBox(confirmMsg, vbOKCancel + vbQuestion, "確認") = vbCancel Then Exit Sub End If i = 5 ' ヘッダー行の下に開始行を設定 count = 0 ' 取得件数をカウントする変数を追加 ' サブフォルダとファイルを再帰的に検索 For Each objSubFolder In objFolder.SubFolders For Each objFile In objSubFolder.Files ' ファイル情報をワークシートに書き込み Cells(i, 2).Value = objFile.Name ' ファイル名を取得してワークシートに書き込み Cells(i, 3).Value = objFile.DateCreated ' 作成日時を取得してワークシートに書き込み Cells(i, 4).Value = objFile.DateLastModified ' 更新日時を取得してワークシートに書き込み Cells(i, 5).Value = objFile.Size ' ファイルサイズを取得してワークシートに書き込み Cells(i, 1).Value = objSubFolder.Path ' ファイルのパスを取得してワークシートに書き込み i = i + 1 ' 次の行に移動 count = count + 1 ' 取得件数をカウントアップ ' 進捗率を表示 UpdateProgress count, totalCount Next objFile ' サブフォルダを再帰的に検索 Call GetSubFolderInfo(objSubFolder, i, count, totalCount) Next objSubFolder ' C3 セルに取得件数を表示 Range("C3").Value = "取得ファイル数: " & count & "件" End Sub Sub GetSubFolderInfo(objSF As Object, ByRef i As Long, ByRef count As Long, ByVal totalCount As Long) ' GetFilesAndFoldersInfo サブルーチンから呼び出される、サブフォルダ内のファイル情報を取得するサブルーチンです。 Dim objFSO As Object ' FileSystemObject を格納する変数 Dim objFolder As Object ' フォルダを格納する変数 Dim objSubFolderItem As Object ' サブフォルダを格納する変数 Dim objFile As Object ' ファイルを格納する変数 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(objSF.Path) ' サブフォルダとファイルを再帰的に検索 For Each objSubFolderItem In objFolder.SubFolders For Each objFile In objSubFolderItem.Files ' ファイル情報をワークシートに書き込み Cells(i, 2).Value = objFile.Name ' ファイル名を取得してワークシートに書き込み Cells(i, 3).Value = objFile.DateCreated ' 作成日時を取得してワークシートに書き込み Cells(i, 4).Value = objFile.DateLastModified ' 更新日時を取得してワークシートに書き込み Cells(i, 5).Value = objFile.Size ' ファイルサイズを取得してワークシートに書き込み Cells(i, 1).Value = objSubFolderItem.Path ' ファイルのパスを取得してワークシートに書き込み i = i + 1 ' 次の行に移動 count = count + 1 ' 取得件数をカウントアップ ' 進捗率を表示 UpdateProgress count, totalCount Next objFile ' サブフォルダを再帰的に検索 Call GetSubFolderInfo(objSubFolderItem, i, count, totalCount) Next objSubFolderItem End Sub Function CountFilesInFolder(objFolder As Object) As Long ' 指定されたフォルダ内のファイル数を再帰的に取得する関数です。 Dim objSubFolder As Object ' サブフォルダを格納する変数 Dim objFile As Object ' ファイルを格納する変数 Dim count As Long ' ファイルの総数を格納する変数 ' サブフォルダとファイルを再帰的に検索 For Each objSubFolder In objFolder.SubFolders count = count + CountFilesInFolder(objSubFolder) ' サブフォルダ内のファイル数をカウント Next objSubFolder For Each objFile In objFolder.Files count = count + 1 ' ファイル数をカウント Next objFile CountFilesInFolder = count ' ファイル総数を返す End Function Sub UpdateProgress(ByVal currentCount As Long, ByVal totalCount As Long) ' 進捗状況を表示するサブルーチンです。 Dim progressMsg As String ' 進捗状況を格納する文字列 Dim progressRatio As Double ' 進捗率 ' 進捗率を計算 progressRatio = currentCount / totalCount progressMsg = "進捗率: " & Format(progressRatio, "0.0%") & vbCrLf ' 進捗バーを表示 Application.StatusBar = progressMsg With Application ' 進捗率と進捗バーを表示 .StatusBar = progressMsg & String(progressRatio * 50, "■") & String((1 - progressRatio) * 50, "□") ' ステータスバーをクリア .StatusBar = False End With End Sub
Module3（検索フォール表示プログラム）
検索フォーム（UserForm1）を表示するためのマクロです。
'以下のマクロは、フォームを表示するために使用されます。 '具体的には、CommandButton1をクリックすると、UserForm1が表示されます。 Sub CommandButton1_Click() UserForm1.Show ' UserForm1を表示するためのメソッドを呼び出す End Sub
UserForm1（検索フォーム）
フォームの設計
フォーム内のコード
Private Sub UserForm_Initialize() ' フォーム初期化時にリストボックスを空にする ListBox1.Clear End Sub Private Sub TextBox1_Change() ' テキストボックスの内容が変更されたときにファイル名と更新日時を検索し、リストボックスに表示する Dim searchTerms() As String Dim searchTerm As String Dim lastRow As Long Dim cell As Range Dim i As Long ' 検索語句を取得する searchTerms = Split(Replace(TextBox1.Text, " ", " "), " ") ' リストボックスを空にする ListBox1.Clear ' ファイル名を検索する lastRow = Cells(Rows.count, "B").End(xlUp).Row For Each cell In Range("B5:B" & lastRow) ' 検索語句が2文字以上の場合に検索を行う If Len(TextBox1.Text) >= 2 Then For i = LBound(searchTerms) To UBound(searchTerms) searchTerm = Trim(searchTerms(i)) ' 検索語句がファイル名または更新日時に含まれるかどうかを検索する If searchTerm <> "" And InStr(cell.Value, searchTerm) = 0 And InStr(cell.Offset(0, 1).Value, searchTerm) = 0 Then Exit For End If Next i ' 配列内のすべてのキーワードがファイル名または更新日時に含まれる場合、リストボックスに追加する If i > UBound(searchTerms) Then ListBox1.AddItem cell.Value & " - " & cell.Offset(0, 1).Value End If End If Next cell End Sub Private Sub ListBox1_Click() ' リストボックスで選択されたファイル名が入力されたセルに移動する Dim selectedValue As String Dim cell As Range ' 選択されたファイル名を取得する selectedValue = ListBox1.Value ' 選択されたファイル名を含むセルを検索する For Each cell In Range("B5:B" & Cells(Rows.count, "B").End(xlUp).Row) If cell.Value = Left(selectedValue, Len(cell.Value)) Then ' セルが見つかった場合に、そのセルに移動する cell.Activate Exit For End If Next cell End Sub
用語の補足説明
サブルーチン
サブルーチンとは、VBAのプログラムの中で、特定の処理を行うために用いられる部品のようなものです。複数の場所で同じ処理が必要な場合や、大きなプログラムを小さな部品に分割して書く場合に役立ちます。
サブルーチンは、関数と同様に、 Sub というキーワードで始まり、処理の本体を記述するブロックを囲みます。ただし、サブルーチンは値を返さないため、 Function とは異なります。
サブルーチンは、プログラム内で他のサブルーチンや関数から呼び出すことができます。このように、プログラム内の複数の場所で同じ処理が必要になった場合に、同じ処理を何度も書く必要がなく、サブルーチンを呼び出すだけで処理を実行することができます。
上記のModule2に含まれるサブルーチンは、GetFilesAndFoldersInfo、 GetSubFolderInfo及びCountFilesInFolderです。それぞれのサブルーチンは、特定の処理を行うために作成され、それぞれの役割を担っています。これらのサブルーチンを動作させることにより、フォルダ内のファイル情報を取得し、Excelのワークシートに書き込むことができます。
再帰的に検索
「再帰的に検索」とは、フォルダ内に存在するすべてのサブフォルダやファイルを検索する際に、自分自身を呼び出して処理を繰り返すことを指します。
例えば、あるフォルダ内に複数のサブフォルダがあり、それぞれのサブフォルダにさらに別のサブフォルダやファイルが存在する場合を想定します。この場合、全てのファイルを検索するためには、最上位のフォルダから順番に、各サブフォルダを検索していく必要があります。
再帰的な処理では、最上位のフォルダから最初のサブフォルダを検索した後、そのサブフォルダ内にさらに別のサブフォルダがある場合、自身を呼び出してそのサブフォルダを検索します。その後、次のサブフォルダがある場合も同様に処理を繰り返し、全てのフォルダとファイルを検索します。
最後に
「ファイルコンパス」のロゴが結構気に入っています(^^♪
