ファイル一覧取得

今日は、あるフォルダー配下のサブフォルダーも含めたファイル一覧を取得します。

今回は、サブルーチンからサブルーチンを呼んでいます。
又、サブルーチンが自分自身を呼んでいますが、これを再帰呼び出しと呼びますが、これにより、プログラムが単純化され、行数も少なくてすみます。

GetFilesサブルーチンには、フォルダー名とファイルパターン（例では、EXCELファイルだけを取得する為に、*.xlsとしています）を指定すると、その条件に合致したファイル名一覧をシートの11行目以降に表示します。

Public Sub ファイル一覧取得()
  On Error Resume Next
  Dim wFiles() As String
  Dim i As Integer
  Dim wFolder As String
  wFolder = "C:\Documents and Settings\azukei\My Documents\EXCELツール"
  'ファイル一覧取得サブルーチンを呼ぶ
  Call GetFiles(wFolder, "*.xls", wFiles())
  '13行目以降を選択する
  Range(Cells(13, 1), ActiveCell.SpecialCells(xlLastCell)).Select
  '選択したエリアをクリアする
  Selection.ClearContents
  '11行目1列目にフォルダー名をセットする
  Cells(11, 1) = wFolder
  '13行目より、取得したファイル名をセットする
  For i = 0 To UBound(wFiles)
      Cells(i + 13, 1) = wFiles(i)
  Next
  Cells(1, 1).Select
End Sub

Public Sub GetFiles(ByVal pFolder As String, ByVal pPattern As String, ByRef pFiles() As String)
  On Error Resume Next
  Dim i As Integer
  Dim wFile As String
  Dim wSubFolder As String
  '配列（pFiles）の最大インデックスを取得する
  i = UBound(pFiles)
  'フォルダー内の最初のファイルを取得する
  wFile = Dir(pFolder & "\" & pPattern, vbNormal)
  Do Until wFile = ""
     '配列の要素数を動的に変更する
     ReDim Preserve pFiles(i)
     pFiles(i) = pFolder & "\" & wFile
     i = i + 1
     'フォルダー内の次のファイルを取得する
     wFile = Dir
  Loop
  'フォルダー内の最初のサブフォルダーを取得する
  wSubFolder = Dir(pFolder, vbDirectory)
  Do Until wFile = ""
     '自分自身のサブルーチンを呼ぶ（再帰呼び出し）
     Call GetFiles(wSubFolder, pPattern, pFiles())
     'フォルダー内の次のサブフォルダーを取得する
     wSubFolder = Dir
  Loop
End Sub

今日はここまで！

それでは！