フォルダ構造を一覧にするExcel VBA

仕事してて、フォルダ構造と収納されているファイルを一覧にしたいなって思ったことないですか？

#Excel VBAで作っておきました。

どうぞ。
使ってください。
編集しないといけない点は、変数”Path”の値だけです。

14年ぶりにプログラミング書いてるので、リファクタリングしてくれる人募集中ですm(__)m

Dim numOfDelimiter As Long

Sub mainFFs()
   
   'Declare
   Dim subFolders As Object
   Dim Path As String
   Dim rowP As Long
   Dim culP As Long
   Dim numOfSubF As Long
   Dim buf As String
   
   'Set values
   
   Path = "C:\Users\" 'ここに一番上のフォルダを指定してくださいね
   rowP = 1
   culP = 1
   
   'Pathに \ が何個あるか数える
   numOfDelimiter = UBound(Split(Path, "\"))
   
   '指定したフォルダだけ、書いてしまう
   Cells(1, 1) = Path
   culP = culP + 1
   buf = Dir(Path & "\*.*")
   Do While buf <> ""
       Cells(rowP, culP) = buf
       rowP = rowP + 1
       buf = Dir()
   Loop
   
   Call writeSubFFs(Path, culP, rowP)

End Sub

Sub writeSubFFs(Path As String, culP As Long, rowP As Long)
      
   '階層の調整
   Dim curPath As Long '文字カウント数
   curPath = UBound(Split(Path, "\"))
   
   If curPath <= numOfDelimiter + 1 Then
       culP = 3
   Else
       culP = culP + 1
   End If
   
   '*** Process ****
   
   '①フォルダ取得
   Set subFolders = CreateObject("Scripting.FileSystemObject").GetFolder(Path).subFolders
   
   For Each subFolders In subFolders
   
   '②フォルダ記載
       
       Path = subFolders.Path
       Cells(rowP, culP) = Path
       
   '③ファイル取得
       culP = culP + 1
       On Error Resume Next
       buf = Dir(Path & "\*.*")
   '④ファイル記載
       Do While buf <> ""
           Cells(rowP, culP) = buf
           rowP = rowP + 1
           buf = Dir()
       Loop
   
   
       culP = culP - 1
       rowP = rowP + 1
   
       Call writeSubFFs(Path, culP, rowP)
   
   Next subFolders
End Sub

因みに、writeSubFFsは自身を再起してます。
（下から４行目のCallで）
理由は、再起しないとSubフォルダ１階層分しか取得できなかったため。

今後の応用としては、パスをリンクにしてみたり、2個のHDDの差分のみを同期するみたいなファイルの前段の処理として利用したり（車輪再発名しそうな予感）、書き出す対象ファイルに条件を付けて、欲しいファイルのみ記載したりなど、色々できますよね。

注意点：
　Cドライブから実行すると、
　私の環境だと、とんでもない量のファイルになりそうでした。
　（以下は、45万ファイル検出くらいで処理を止めました。の図）
　そこまで検出したくない場合は、対象ファイルを限定するなり、行のカウンターに制限を設けるなりした方が良いかもです。

#参考にしたサイト

結局これを改編したのが今回のコード
https://www.moug.net/tech/exvba/0060088.html

これそのまま実装したかったけど、basファイルがめんどかった
https://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html
https://www.asahi-net.or.jp/~ef2o-inue/download/sub09_020_110.html

SESだと、権限の関係でさわれないフォルダがあるので、on error resume nextで飛ばす
http://officetanaka.net/excel/vba/tips/tips104.htm

今後の応用
http://officetanaka.net/excel/vba/tips/tips95.htm
http://blog.jmiri.net/?p=1763