下ごしらえ　ファイルリストをマクロで作成する

これを使って、こんなファイルリストのテーブルを作成します。
※マクロのアレンジor出力後のテーブル整形が必要です

id	FileName	Path
1	ファイル1	Z:\●●●\▲▲▲\ファイル1
2	ファイル2	Z:\●●●\▲▲▲\ファイル2
3	ファイル3	Z:\●●●\▲▲▲\ファイル3
4	ファイル4	Z:\●●●\▲▲▲\ファイル4
5	ファイル5	Z:\●●●\▲▲▲\ファイル5
6	ファイル6	Z:\●●●\▲▲▲\ファイル6
7	ファイル7	Z:\●●●\▲▲▲\ファイル7
8	ファイル8	Z:\●●●\▲▲▲\ファイル8
9	ファイル9	Z:\●●●\▲▲▲\ファイル9
10	ファイル10	Z:\●●●\▲▲▲\ファイル10

各ファイルのプロパティをマクロで取得する

ファイルリストテーブル上のセル選択状態でPathリストからプロパティを取得を実行すると
3列分のデータが書き込まれる、というものです。

※数万ファイル一気に実行すると途中で止まった場合に悲しい思いをするのでid列でフィルタリングするなどして何回かに分けた方が良いです。検索対象範囲は可視セルに絞るようにしてあるのでフィルタ条件以外に注意点は特にありません。

id	FileName	Path	Date	Size_MB	Type
1	ファイル1	Z:\●●●\▲▲▲\ファイル1	2017/6/20 21:36	1.18	bat
2	ファイル2	Z:\●●●\▲▲▲\ファイル2	2021/4/23 11:34	0.304	txt
3	ファイル3	Z:\●●●\▲▲▲\ファイル3	2020/11/27 13:36	4015.151	pdf
4	ファイル4	Z:\●●●\▲▲▲\ファイル4	2020/11/27 13:34	4975.491	pdf
5	ファイル5	Z:\●●●\▲▲▲\ファイル5	2020/11/27 13:37	5026.729	pdf
6	ファイル6	Z:\●●●\▲▲▲\ファイル6	2020/11/27 13:37	3495.345	pdf
7	ファイル7	Z:\●●●\▲▲▲\ファイル7	2020/11/27 13:38	5673.907	pdf
8	ファイル8	Z:\●●●\▲▲▲\ファイル8	2020/11/27 13:38	2736.738	pdf
9	ファイル9	Z:\●●●\▲▲▲\ファイル9	2020/11/30 16:10	2720.37	pdf
10	ファイル10	Z:\●●●\▲▲▲\ファイル10	2018/8/1 18:57	46.126	exe

コード：標準モジュール

Option Explicit
Option Base 1

Private Enum c
  c_id = 1
  c_fName
  c_fPath
  c_ファイルの更新日時
  c_ファイルサイズ
  c_ファイル拡張子
End Enum
Const cLast = c.c_ファイル拡張子
Const cResize = c.c_ファイル拡張子 - c.c_fPath

Dim Arrファイルの更新日時() As Date
Dim Arrファイルサイズ() As Double
Dim Arrファイル拡張子() As String
Dim my検索結果2D() As Variant


Sub Pathリストからプロパティを取得()
  On Error Resume Next
  
  Dim FSO As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Application.ScreenUpdating = False
  
  '検索エリア設定
  Dim myListObj As ListObject
  Set myListObj = ActiveCell.ListObject
  Dim Area可視セル As Range
  Set Area可視セル = GetArea可視セル(myListObj)
  
  Dim Rng1st As Range
  Set Rng1st = Area可視セル(1, c.c_fPath)
  
  Dim Arr検索対象 As Variant
  Arr検索対象 = Area可視セル.Value2
  
  '配列用意
  Dim cnt As Long
  cnt = UBound(Arr検索対象, 1)
  ReDim Arrファイルの更新日時(cnt)
  ReDim Arrファイルサイズ(cnt)
  ReDim Arrファイル拡張子(cnt)
  ReDim my検索結果2D(cnt)
  
  '結果を配列に入れていく
  Dim i As Long
  For i = 1 To cnt
    Arrファイルの更新日時(i) = Getファイルの更新日時(Arr検索対象(i, c.c_fPath))
    Arrファイルサイズ(i) = Getファイルサイズ(FSO, Arr検索対象(i, c.c_fPath))
    Arrファイル拡張子(i) = Getファイル拡張子(FSO, Arr検索対象(i, c.c_fPath))
  Next
  
  '2次元配列にまとめる
  my検索結果2D = Array(Arrファイルの更新日時, Arrファイルサイズ, Arrファイル拡張子)
  '貼り付け用に転置する
  my検索結果2D = WorksheetFunction.Transpose(my検索結果2D)
  
  '配列からシートに転記
  Dim Area結果出力 As Range
  Set Area結果出力 = Rng1st.Offset(0, 1).Resize(cnt, cResize)
  
  Area結果出力 = my検索結果2D
  
  Call Setテーブルヘッダ名(myListObj)
  
  Set FSO = Nothing
  Application.ScreenUpdating = True
  
End Sub

Private Function GetArea可視セル(myListObj As ListObject) As Range
  Dim Area可視セル As Range
  Set Area可視セル = myListObj.DataBodyRange.SpecialCells(xlCellTypeVisible)
  Set GetArea可視セル = Area可視セル
End Function

Private Sub Setテーブルヘッダ名(myListObj As ListObject)
  Dim Header
  Header = Array("id", "FileName", "Path", "Date", "Size_MB", "Type")
  
  Dim AreaHeader As Range
  Dim i
  For i = 1 To UBound(Header)
    myListObj.HeaderRowRange(1, i) = Header(i)
  Next
End Sub
 
Private Function Getファイルの更新日時(filePath) As Date
    Getファイルの更新日時 = FileDateTime(filePath)
End Function

Private Function Getファイルサイズ(FSO As Object, filePath) As Double
    Getファイルサイズ = FSO.GetFile(filePath).Size / 1000
End Function

Private Function Getファイル拡張子(FSO As Object, filePath) As String
  Getファイル拡張子 = FSO.GetExtensionName(filePath)
End Function

マクロ実行後からがようやくスタート：ピボットテーブルにまとめて分類

吐き出したデータをピボットテーブルにまとめて分類していきます。

テーブルはSize_MBでしたが、集計するとMBだと桁がやばいことになるので表示形式でGBに直してやりましょう
[<1000]#,##0.###,"GB";[>=1000]#,##0,"GB"

見た目ですぐわかるようにデータバーでも付与してやりましょう。

お、
解凍後に消してないと思われるzipファイルだけでも5TB以上ありますね。これは由々しき事態ですよ、ポッター。

ピボットテーブル補助 `udf_Split`でファイルパスを階層ごとに分割

好きなだけパス列を追加して、UDFを上のテーブルに仕込みます。
※仕込んで値を取り出した後は値貼り付けして関数を殺した方が軽くなって良いです。

COLUMN()-COLUMN(テーブル1[[#見出し],[Path1]])+7のところは

基準列-COLUMN(テーブル1[[#見出し],[Path1]])からの差分が自動的にCOLUMN関数で付与されるようにしてあるのですべてのパス列で同じ関数を敷き詰めれば良いです。

末尾の+7というのはサーバ上の階層構造次第なので各自自由に設定してください。

Path1	Path2	Path3
=udf_Split([@Path],"",COLUMN()-COLUMN(テーブル1[[#見出し],[Path1]])+7)	=udf_Split([@Path],"",COLUMN()-COLUMN(テーブル1[[#見出し],[Path1]])+7)	=udf_Split([@Path],"",COLUMN()-COLUMN(テーブル1[[#見出し],[Path1]])+7)

するとピボットテーブルの切り口をある階層のフォルダ別に指定することができるようになります。

ピボットテーブルの素晴らしいところは切り口をパパッとすぐに変えられるところですね。

ピボットテーブル補助 `IFS関数`

マクロでできたテーブルにIFSという列を追加します。

ピボットテーブルや元のテーブルの値を眺めながら、何か重そうだなと思ったKWをIFS関数に入れて仕訳けていくとより分かりやすい形にまとめられます。

=IFS( COUNTIF([@FileName],"*KW1*")>0,"KW1", COUNTIF([@Path],"*KW2*")>0,"KW2", COUNTIF([@Path],"*KW3*")>0,"KW3", COUNTIF([@Path],"*KW4*")>0,"KW4", COUNTIF([@Path],"*KW5*")>0,"KW5" )

各KWは伏せていますが、仮置きやチェック履歴ファイルのあるフォルダが大量に容量を食ってることがわかったのでそのあたりの保管期間や軽量化を提案しようと思います。

なんと各人の受信メールを関係者に共有するためにmsgファイルを各案件フォルダにエビデンスとして残すという不経済なデータ保管をしている為ここも気にかけていました。(添付ファイルはメールから取り出したものと重複しているので本当に不経済因子ですよ！)

ただ、こいつはpdfに比べたら大した容量は食ってないのでひとまず後回しにしようかな。

msgファイルはよく文字化けしたりそもそも開くのに時間がかかったり繋がりが見えにくい等多々不満はありますがTeamsほか情報共有ツールの土壌がまだまだなのでそのあたりも改善するとここらの容量も回り回って浮かせられますね。

連絡・やりとりの残し方でいい方法ご存知の方がいらっしゃいましたら教えていただけると嬉しいです。