あるフォルダの下全部VBA.Dir関数

ooooo

5年前

次図は、再帰呼び出しの説明用です。再帰呼び出しとは、プロシージャの中で自分自身のプロシージャを呼び出すことです。作った関数はVBAの機能だけで使える。

次図のディスクトップのabcフォルダ以下の検索を例に説明する。

以下の内容のファイルをディスクトップに作って下さい。ファイル名はmakeabc.batです。このファイルをダブルクリックするとディスクトップ上にmakeabc.batがあればディスクトップ下に同じフォルダができます。

mkdir abc
copy makeabc.bat abc\a.txt
copy makeabc.bat abc\b.txt
mkdir abc\456
copy makeabc.bat abc\456\a.txt
copy makeabc.bat abc\456\b.txt
mkdir abc\123
copy makeabc.bat abc\123\a.txt
mkdir abc\123\aaa
copy makeabc.bat abc\123\aaa\aa.txt
copy makeabc.bat abc\123\aaa\bb.txt

以降は、作成した関数（Functionプロシージャ）の説明。

ディレクトリ構造を再帰呼び出しで処理するには、再帰呼び出し前の処理とその後の処理に分けて考える。

前半：再帰呼び出しの対象はフォルダ。プロシージャの引数のフォルダ下（直下のフォルダだけ）の全フォルダを調べ。直下のフォルダだけに対して再帰呼び出しする。①と②
後半：プロシージャの値を改行コードをはさんで作る。直下のファイルだけを処理する。目的の処理。③

再帰呼び出しは、呼び出し時に一時的に積まれる変数、プロシージャの引数やプロシージャ内の変数はすべて呼び出しの度に個別にスタックに積まれる。呼び出し時に積まれるスタックを意識できるのは次図のエラーだろう。

スタックの存在は、次のコードを実行すると「スタックオーバー」のエラーになるのでスタックの存在がわかる。

Sub main()
  a 1, 2
End Sub

Sub a(引数1 As Integer, 引数2 As Long)
  Dim ii As Long 'ローカル変数。aプロシージャ内で有効な変数。プロシージャレベルの変数
  引数1  = ii + 1
  a 引数1, 引数2 + 1  '自分自身を呼び出す。再帰呼び出しでスタックにデータをその都度積む
End Sub

注意！作成中のExcelやWordが飛ぶことがあります。私の環境Office32ビット、Windows10は64ビットでは２度以上実行すると飛びました。Excel本体が動くメモリ領域の下のアドレスからアドレス番地をアップしていきます。Excel本体のメモリまで突入？。会社のPCでも32ビットのOfficeですが問題ありません。私のPCが例外です。

再帰呼び出し/リカーシブルコールは、以下の２つの図の考えが必要です。

引数は、呼び出し側から渡された変数。プロシージャー内でDim宣言した変数は内部で使える一時的な変数。これらは、再帰呼び出し毎に違う。再帰呼び出しのプロシージャーを書くときは各処理で引数に応じて処理が完結できるように書く。でも、プロシージャー名が同じで引数は違うって言ってもなかなかね。上図をもう一度見て下さい。フォルダごとに引数が違います！！。

引数とプロシージャ内でDim宣言した変数は呼び出し毎に別のメモリで動くという考え方

今回使った関数のコードです。

'vba.dirで再帰処理
Function myAllFileFolder(sPath As String, sWildCard As String) As String
   On Error GoTo myErr '使用中や権限のなのﾌｧｲﾙを扱ったときは、無視させる
   Dim r As String, col As New VBA.Collection
   If VBA.Right(sPath, 1) <> "\" Then sPath = sPath & "\" 'sPath最後が\で無い場合\を付ける
'あるフォルダ内の全フォルダを検索して、colに登録
   r = VBA.Dir(sPath & "*.*", vbDirectory) 'vbDirectoryでもファイルを含むので以後でGetAttrで分別
   Do Until r = ""
      If r <> "." And r <> ".." Then '無視。"."は自分のﾃﾞｨﾚｸﾄﾘ。".."は親ﾃﾞｨﾚｸﾄﾘ
        If VBA.GetAttr(sPath & r) = VBA.vbDirectory Then   'フォルダ/ﾃﾞｨﾚｸﾄﾘの場合だけ
            col.Add r
        End If
      End If
      r = VBA.Dir
      DoEvents '長い場合に中断できるようにWindowsからのメッセージを受け付ける
   Loop
'ﾃﾞｨﾚｸﾄﾘの場合は、再帰呼び出し
   Dim x
   For Each x In col
            myAllFileFolder = myAllFileFolder & myAllFileFolder(sPath & x, sWildCard) '再帰呼び出し
   Next
'sWildCardで指定したﾌｧｲﾙだけを検索。検索対象はsPathﾌｫﾙﾀﾞ内だけ
   r = VBA.Dir(sPath & sWildCard, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) '全ファイルが検索対象
   Do Until r = ""   '""は、もう該当のﾌｧｲﾙがないことを意味する
      If r <> "." And r <> ".." Then '無視。"."は自分のﾃﾞｨﾚｸﾄﾘ。".."は親ﾃﾞｨﾚｸﾄﾘ
         myAllFileFolder = myAllFileFolder & sPath & r & VBA.vbCrLf '改行ｺｰﾄﾞを挟んで検索されたﾌｧｲﾙ名を保存
      End If
      r = VBA.Dir '繰り返し
      DoEvents '長い場合に中断できるようにWindowsからのメッセージを受け付ける
   Loop
   Exit Function
myErr: '多くのエラーは権限の問題
   Debug.Print Err.Number, Err.Description
   Debug.Print sPath, r
'   Stop 'エラーが多い場合の確認用
   Resume Next '状況を出力したら、やりなおしはResume。もし、そのエラーを無視して次へ行く場合はResume Nextに
End Function
'?myAllFileFolder(VBA.Environ("userprofile")  & "\desktop\abc", "*.*")
'?myAllFileFolder("c:\windows\system32\drivers","*.*")