【VBA】フォルダ内のファイル一覧を，サブフォルダも含めて高速に取得する

　サブフォルダも含めてファイルリストを取得したいとき，すぐ思いつくのはFile System Object（FSO）を使う方法だろうが，データ数が多かったり，フォルダの階層が複雑だと正直おそい．

　特にサーバ上にあるフォルダ内を参照する場合は，環境にもよるが，泣きそうなぐらいおそい．

　私の知る限り，最も高速なのは，下記のように，Windows Script Host（WSH）のdirで取得する方法だと思う．

　マクロ有効ファイルの「A1」セルにフォルダパスを貼り付ければOK．

　ちなみにWindowsでは，当該フォルダを「Shift」+右クリックでパスをコピーできる（これすごい便利）．

　当初は付け焼き刃と思っていたが，意外と3年間は重宝している．

　まぁこのやり方だとフルパスでしか取得できないため，ファイル名だけを欲しかったり，両方必要だという人は，コードをちょこっと変えたらできるので，いろいろいじってほしい．

　このコードのポイントは，下記3つ．

• 一旦コマンドプロンプトでファイルリストをテキスト形式でデスクトップに出力（csvでもいいね）（気分的に目に見えるデスクトップに保存）
• ファイルリストをExcelで開いて全部コピー（エクセルはこういうのは得意）
• ファイルリストは削除（邪魔だからね）

Sub sample()
  Call Search_Files(Range("A1").Value)
End Sub

Sub Search_Files(Path As String)
  Dim WSH, sCmd As String
  Dim dPath As String
  Dim wTXT As Workbook
  Dim rEnd As Long
  
  Set WSH = CreateObject("WScript.Shell")
  dPath = WSH.SpecialFolders("Desktop") & "\"
  sCmd = "dir " & path & " /b /a-d /s > " & dPath & "filelist.txt"
  WSH.Run "%ComSpec% /c " & sCmd, 0, True
  Set WSH = Nothing
  
  Set wTXT = Workbooks.Open(dPath & "filelist.txt")
  rEnd = Cells(Rows.Count, 1).End(xlUp).Row
  Range("A1:A" & rEnd).Copy ThisWorkbook.Worksheets(1).Range("B1:B" & rEnd)
  wTXT.Close savechanges:=False
  Kill dPath & "\filelist.txt"
  Set wTXT = Nothing
End Sub