「共有サーバ容量がパンクしてファイル追加ができない！？」なんてことありませんか？
うちは今まさにこれにぶち当たっています。
そこで
- 全部で何TBあるのか
- どんなファイルが多くを占めているのか
- パッと見て消して良さそうなのか
- 精査に労力をかける程の食い様なのか
- 思い当たるひな形フォルダ名ごとに傾向はないか
を整理してみたので、それに使ったマクロとピボットテーブルの作り方をまとめてみました。
下ごしらえ ファイルリストをマクロで作成する
これを使って、こんなファイルリストのテーブルを作成します。
※マクロのアレンジ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 | |
| 4 | ファイル4 | Z:\●●●\▲▲▲\ファイル4 | 2020/11/27 13:34 | 4975.491 | |
| 5 | ファイル5 | Z:\●●●\▲▲▲\ファイル5 | 2020/11/27 13:37 | 5026.729 | |
| 6 | ファイル6 | Z:\●●●\▲▲▲\ファイル6 | 2020/11/27 13:37 | 3495.345 | |
| 7 | ファイル7 | Z:\●●●\▲▲▲\ファイル7 | 2020/11/27 13:38 | 5673.907 | |
| 8 | ファイル8 | Z:\●●●\▲▲▲\ファイル8 | 2020/11/27 13:38 | 2736.738 | |
| 9 | ファイル9 | Z:\●●●\▲▲▲\ファイル9 | 2020/11/30 16:10 | 2720.37 | |
| 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ほか情報共有ツールの土壌がまだまだなのでそのあたりも改善するとここらの容量も回り回って浮かせられますね。
連絡・やりとりの残し方でいい方法ご存知の方がいらっしゃいましたら教えていただけると嬉しいです。