Access2000VBA・Excel2000VBA独学～フォルダの中に含まれる全てのファイルを（全てのサブフォルダの中も全部）再帰的に順に編集するサンプルプログラム～

Access2000VBA・Excel2000VBA独学～フォルダの中に含まれる全てのファイルを（全てのサブフォルダの中も全部）再帰的に順に編集するサンプルプログラム～
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　

　　
※2022/12/06 追記

★かなり重要な注意事項
後述の「Dir」を使う場合に関しては、
「Dir関数は認識できない文字（文字コード？）があるらしく、また、最悪なことに、プログラムの書き方によっては、”エラーが出てほしいところで出ない”」
という機能不足や不都合があるようです。
システムとしては致命的になってしまうので、基本的には「使わないほうが無難」なようです。

どうしても使いたいなら
『「確実にパソコン内」だけで付けたファイル名しか「絶対に・100％」ありえない』、
という前提の場合しか役に立たないようです。

また、Dir関数を使うほうが速度は４、５倍は速いようですが、一部のファイル名を認識できずにエラーになるようでは、全てのファイルやフォルダを拾えません。「４、５倍は速い」なんてものは何の意味もない、ということになります。

そのあたりについて詳しく書いてあるWebサイトをご紹介します。
mhtmlなどで保存しておくことをおすすめします。
VBAでファイルリストを高速に取得する関数を自作する part1
VBAでファイルリストを高速に取得する関数を自作する part2
VBAでファイルリストを高速に取得する関数を自作する part3
VBAでファイルリストを高速に取得する関数を自作する part4

↑「ファイル・フォルダリストをゲットするだけ」というシーンでしか使えないかもしれませんが、Dir関数を使うよりも何倍も速いプログラムコードも紹介されています。
もちろん、文字コードの問題もありません。
ほんと、mhtmlなどで保存しておくことをおすすめします。
　　

★ 参考サイト

『[VBA]サブフォルダ含むファイル一覧を再帰的に取得する』
『サブフォルダを含めてファイル一覧を取得する（Dir関数の再帰呼び出し）』
　　
　　

★ 重要な注意01

今回のような「すべてのサブフォルダのファイルに全部処理をする」みたいな処理をしたい場合方法は以下の(A)か(B)の２つの方法があります。

(A)「Dir()」を併用する方法
現在のディレクトリのファイル名の一覧取得や書き出し→Dir()を使ったループ
サブフォルダの全階層を覗きに行く→FSOを使ったループ

(B)「全部FSO」を使う方法　　　※FSO＝FileSystemObject＝MSScriptingRuntime
現在のディレクトリのファイル名の一覧取得や書き出し→FSOを使ったループ
サブフォルダの全階層を覗きに行く→FSOを使ったループ

で、このとき、

(A)のDir()を併用する場合は、「さらにDir()で他のフォルダの存在チェックをしながら一覧ループでもDir()を使う」とエラーになったり、変な動きになったりします。
Dir()のループの途中に、その中でまたDir()してしまうと、その時点でそれまでのDir()の内容が書き換わってしまい、挙動がおかしくなるようです。

なので、
「すべてのサブフォルダをループする」中で、さらに、
「他のフォルダやファイルの存在チェックの分岐等々を入れたい」というときは・・・、

(01)Dir()を使わない。
(02)現在の階層のファイル一覧の書き出しも、他のフォルダやファイルの各種チェックも、再帰的ループも、「全部、FSOでやる」。
(03)もしDir()を使いたいなら、FSOのファイル名取得の再帰的ループの中で、「他の特定のファイルやフォルダの存在チェック」「だけ」に使う。

・・・としたほうが、エラーが出なくて無難かと思います。

Dir()を併用する方法でもエラーが出ないやり方があるかもしれませんが、もちろん、「全部FSOでやってしまう」のもラクだと思います。

逆に、

『単純にファイル名を（サブフォルダも全部）一覧書き出ししたい場合』、や、
『さらに、他のフォルダやファイルの存在チェック等々を「全くしないで」、全サブフォルダへの再帰的ループをかけたい場合』、等々は、

Dir()＋FSOでOKです。

そういう形で、「サブフォルダのすべてのファイルのデータを何の条件も無しに１つのファイルにまとめたい」というようなときは、Dir()を併用しても一応はOKかと思います。

でも、将来的に『さらに、他のフォルダやファイルの存在チェック等々を「する！」』ことを想定するなら、最初から全部、FSOでやってしまうほうがラクだと思います。

「サブフォルダのすべてのファイルのデータを１つのファイルにまとめたいけど、特定のファイル名のファイルは除外したい」とか、
「サブフォルダのすべてのファイルのデータを１つのファイルにまとめたいけど、処理済みのファイルを、指定の目的のフォルダが無かったらそれを作成し、そこへ入れたい」・・・、
などのケースが、将来的に想定される場合は、最初から全部、FSOだけを使ったほうが無難です。

　　
　　
★ 重要な注意02

この再帰的ループは、どちらかというと、「サブフォルダを全階層覗きに行くループ」中心に動くイメージです。
「現在のディレクトリのすべてのファイルを取得するループ」よりも。

なので、
「サブフォルダを全階層覗きに行くループ」のブロックの「前」の位置で、
「現在のディレクトリのすべてのファイルを取得するループ」を書くと、
ルートの全ファイルの取得→徐々に深い階層のフォルダ・ファイルの取得・・・と昇順なイメージで動きます。

逆に、
「サブフォルダを全階層覗きに行くループ」のブロックの「後ろ」の位置で、
「現在のディレクトリのすべてのファイルを取得するループ」を書くと、
最初のサブフォルダのもっとも深い階層のフォルダ・ファイルの取得→徐々にサブフォルダをさかのぼりつつファイル名を取得
→最後にルートの全ファイルの取得・・・と降順？なイメージで動きます。

これは、(B)の全部FSOでやる場合でも、(A)のDir()を併用する場合でも、どちらの場合でも同じです。

　　
　　
★ 一部にDir()を併用した、「サブフォルダも全部」、の、ファイル名の一覧書き出しの例（(A)の「Dir()」を併用する方法）

※実行時バインディングをするので、「Microsoft Scripting Runtime」に参照設定は不要です。

'
'
Option Explicit

'グローバルカウンタ変数
Dim g_i As Long  '「セルに順番に書き出したいので（セル番地の生成のために）グローバルとして使う」、
                 'というだけのことなので、
                 'イミディエイトに出力するなら、グローバルにしなくてもいいし、
                 'といいますか、そもそも、セル番地を生成しなくてもいいので、これは要らないです。

                 '※セル番地を生成したいときは、サブフォルダ毎に再帰的に処理を繰り返すたびに、
                 '  カウンタ変数が初期値に戻ってしまうため、
                 '  それだと、同じセルが（サブフォルダが切り替わるたびに）上書きされてしまい、
                 '  「一覧にならない」ので、グローバル変数が必要です。

'######################################################################
'指定したフォルダの、すべてのサブフォルダも含めて、再帰的に、
'すべてのファイルのフルパスを調べる。
'######################################################################

Sub AllFolderFullPathGet()

    g_i = 0
    
    ActiveSheet.Cells.ClearContents
    Call RecursiveLoop01("d:\3")
    
End Sub



'######################################################################
'すべてのファイルのフルパスを再帰的に（サブフォルダの中も全部、調べる。
'そして、セル（A列）に書き出す。
'######################################################################

Sub RecursiveLoop01(s_FldPath As String)

    Dim s_Trg01     As String
    Dim o_SubFile   As Object
    Dim o_Fso01     As Object
    
    
    s_Trg01 = Dir(s_FldPath & "\*.*")
    
    
    Do While s_Trg01 <> ""
        g_i = g_i + 1
        Activesheet.Cells(g_i, 1) = s_FldPath & "\" & s_Trg01
        s_Trg01 = Dir()
    Loop
    '↑基本、ここまでが実行されます。
    '　サブフォルダもここまでが実行されます。
    '　つまり、サブフォルダに移動してから、
    '　以降のコードで再帰呼び出しにて、
    '　そのルートのファイル名だけをシートに書き出し、
    '　それを全部のフォルダでやる・・・というイメージです。


    'サブフォルダ調査・取得。
    's_FldPathの中にサブフォルダがあったら
    'そのサブフォルダを引数にして、
    '自分自身(RecursiveLoop01)を再帰的に呼び出す。
    
    Set o_Fso01 = CreateObject("Scripting.FileSystemObject")
        
    For Each o_SubFile In o_Fso01.GetFolder(s_FldPath).SubFolders
        '自分自身の再帰的な呼び出しをしてサブフォルダを調査。
        Call RecursiveLoop01(o_SubFile.Path) 
    Next o_SubFile

    

End Sub
'
'

Option Explicit

'グローバルカウンタ変数

Dim g_i As Long '「セルに順番に書き出したいので（セル番地の生成のために）グローバルとして使う」、

'というだけのことなので、

'イミディエイトに出力するなら、グローバルにしなくてもいいし、

'といいますか、そもそも、セル番地を生成しなくてもいいので、これは要らないです。

'※セル番地を生成したいときは、サブフォルダ毎に再帰的に処理を繰り返すたびに、

' カウンタ変数が初期値に戻ってしまうため、

' それだと、同じセルが（サブフォルダが切り替わるたびに）上書きされてしまい、

' 「一覧にならない」ので、グローバル変数が必要です。

'######################################################################

'指定したフォルダの、すべてのサブフォルダも含めて、再帰的に、

'すべてのファイルのフルパスを調べる。

'######################################################################

Sub AllFolderFullPathGet()

g_i = 0

ActiveSheet.Cells.ClearContents

Call RecursiveLoop01("d:\3")

End Sub

'######################################################################

'すべてのファイルのフルパスを再帰的に（サブフォルダの中も全部、調べる。

'そして、セル（A列）に書き出す。

'######################################################################

Sub RecursiveLoop01(s_FldPath As String)

Dim s_Trg01 As String

Dim o_SubFile As Object

Dim o_Fso01 As Object

s_Trg01 = Dir(s_FldPath & "\*.*")

Do While s_Trg01 <> ""

g_i = g_i + 1

Activesheet.Cells(g_i, 1) = s_FldPath & "\" & s_Trg01

s_Trg01 = Dir()

Loop

'↑基本、ここまでが実行されます。

'　サブフォルダもここまでが実行されます。

'　つまり、サブフォルダに移動してから、

'　以降のコードで再帰呼び出しにて、

'　そのルートのファイル名だけをシートに書き出し、

'　それを全部のフォルダでやる・・・というイメージです。

'サブフォルダ調査・取得。

's_FldPathの中にサブフォルダがあったら

'そのサブフォルダを引数にして、

'自分自身(RecursiveLoop01)を再帰的に呼び出す。

Set o_Fso01 = CreateObject("Scripting.FileSystemObject")

For Each o_SubFile In o_Fso01.GetFolder(s_FldPath).SubFolders

'自分自身の再帰的な呼び出しをしてサブフォルダを調査。

Call RecursiveLoop01(o_SubFile.Path)

Next o_SubFile

End Sub

★ 全部「FSO」を使った、「サブフォルダも全部」、の、ファイル名の一覧書き出しの例（(B)「全部FSO」を使う方法）

※事前バインディングをするので、事前に、VBEの画面で「ツール→参照設定」にて、「Microsoft Scripting Runtime」に参照設定することが必要です。

'
'
Option Explicit



Sub getFolderAndFileListMain02()
'https://xxxx7.com/2016/06/06/100040 を加工

    Dim o_AnswFDialg As FileDialog
    Dim s_FoldPath   As String
    
    '★ 設定部
      
'    Set o_AnswFDialg = Application.FileDialog(msoFileDialogFolderPicker)
    s_FoldPath = "D:\3"
    
    '★ 実動部
    ActiveSheet.Cells.ClearContents
    
'    'ファイル選択ダイアログを開き、
'    'フォルダパスを得られたら次へ行き、キャンセルされたらプログラムを終わる。
'    If Not o_AnswFDialg.Show Then Exit Sub
        
    'リスト作成の実行。
'    Call getFolderAndFileListSub(folderPath:=o_AnswFDialg.SelectedItems(1))
    Call getFolderAndFileListSub(folderPath:=s_FoldPath)
    
    
End Sub

'https://xxxx7.com/2016/06/06/100040 を加工

Sub getFolderAndFileListSub(folderPath As String, _
                                      Optional myCount As Long = 0)

    
    'Microsoft Spripting Runtime」 への参照設定が必要。
    
    Dim fso As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
    
 
    'そのフォルダの中「だけ」の、ファイル一覧の書き出し。
    For Each myFile In fso.GetFolder(folderPath).Files
    
        myCount = myCount + 1
        Activesheet.Cells(myCount, 1) = myFile.Path
        
    Next
        
    
    'サブフォルダを再帰的に覗いていくだけの処理。
    'この処理を「フォルダの中のファイル一覧の書き出し。」よりも先にやると、
    'フォルダ構造としては深い階層からの逆順になる
    '（ファイルの並びは昇順だけれども）
    For Each myFolder In fso.GetFolder(folderPath).SubFolders
    
        Call getFolderAndFileListSub(myFolder.Path, myCount)
        
    Next
    
   

End Sub

'
'

Option Explicit

Sub getFolderAndFileListMain02()

'https://xxxx7.com/2016/06/06/100040 を加工

Dim o_AnswFDialg As FileDialog

Dim s_FoldPath As String

'★ 設定部

' Set o_AnswFDialg = Application.FileDialog(msoFileDialogFolderPicker)

s_FoldPath = "D:\3"

'★ 実動部

ActiveSheet.Cells.ClearContents

' 'ファイル選択ダイアログを開き、

' 'フォルダパスを得られたら次へ行き、キャンセルされたらプログラムを終わる。

' If Not o_AnswFDialg.Show Then Exit Sub

'リスト作成の実行。

' Call getFolderAndFileListSub(folderPath:=o_AnswFDialg.SelectedItems(1))

Call getFolderAndFileListSub(folderPath:=s_FoldPath)

End Sub

'https://xxxx7.com/2016/06/06/100040 を加工

Sub getFolderAndFileListSub(folderPath As String, _

Optional myCount As Long = 0)

'Microsoft Spripting Runtime」への参照設定が必要。

Dim fso As New FileSystemObject

Dim myFolder As Folder

Dim myFile As File

'そのフォルダの中「だけ」の、ファイル一覧の書き出し。

For Each myFile In fso.GetFolder(folderPath).Files

myCount = myCount + 1

Activesheet.Cells(myCount, 1) = myFile.Path

'サブフォルダを再帰的に覗いていくだけの処理。

'この処理を「フォルダの中のファイル一覧の書き出し。」よりも先にやると、

'フォルダ構造としては深い階層からの逆順になる

'（ファイルの並びは昇順だけれども）

For Each myFolder In fso.GetFolder(folderPath).SubFolders

Call getFolderAndFileListSub(myFolder.Path, myCount)

End Sub

★ なぜ、「一覧を書き出すループ」と「サブフォルダを覗きに行くループ」を順序を入れ替えると「さかのぼり」によって、降順のようなイメージでの書き出しになるのか？を少し考えるためのテストコード

'
'
'######################################################################
'すべてのファイルのフルパスを再帰的に（サブフォルダの中も全部、調べる。
'そして、セル（A列）に書き出す。
'######################################################################
 
Function RecursiveLoop01(s_FldPath As String)
 
    Dim s_Trg01     As String
    Dim o_SubFoldr  As Object
    Dim o_Fso01     As Object
    
    Dim s_PathChk   As String

g_i2 = 1
 
    '以下のブロックを「サブフォルダ調査・取得。」よりも先にやると
    '昇順に深い階層の曽部フォルダへときれいに並ぶ。
    '後にやると、フォルダの並びが逆順になる。
    'ファイルの並びは昇順。
    'これは、全部をFSOでやった場合も同じ。
    s_Trg01 = Dir(s_FldPath & "\*.*")     'フォルダが確定され、最初のファイル名が変数に代入されます。
    Do While s_Trg01 <> ""              '全部のファイルを処理し、処理し終わったら次のディレクトリ（サブフォルダ）へ行って、このループ（ファイル名のみの一覧表示）を行う。
        g_i = g_i + 1
        Activesheet.Cells(g_i, 1) = s_FldPath & "\" & s_Trg01   'シートへのフルパスの書き出し。
        s_Trg01 = Dir()  '現在のフォルダ「のみ」の、次のファイル名が１ループにつき、１つずつ、順番に入る。全部終わると ”” が入る。
    Loop
    '↑基本、ここまでが実行されます。
    '　サブフォルダもここまでが実行されます。
    '　つまり、サブフォルダに移動してから、
    '　以降のコードで再帰呼び出しにて、
    '　そのルートのファイル名だけをシートに書き出し、
    '　それを全部のフォルダでやる・・・というイメージです。
 
 
 
    'サブフォルダ調査・取得。
    's_FldPathの中にサブフォルダがあったら
    'そのサブフォルダを引数にして、
    '自分自身(RecursiveLoop01)を再帰的に呼び出す。
    
    Set o_Fso01 = CreateObject("Scripting.FileSystemObject") 'ひとつづつ下のフォルダに行くので、その都度、オブジェクト変数への代入が必要？
        
    For Each o_SubFoldr In o_Fso01.GetFolder(s_FldPath).SubFolders  '現在の階層の最初のサブフォルダを処理し、終わったら、更に下の階層のサブフォルダを覗きに行く。
                                                                     'サブフォルダが無くなると、いったんFor Each を抜けて次の行へ行き、はじめにEnd Functionまで行き、（理由はわからないが）またFor Eachの中に戻り、でも、「Callの次の行」とEnd Function を、さかのぼりが終わるまで行ったり来たりする。
        '自分自身の再帰的な呼び出しをしてサブフォルダを調査。
        Call RecursiveLoop01(o_SubFoldr.Path)
        
        '一番最初の ””がイミディエイトに出力されるタイミングは、
        'ルートのサブフォルダがひとつずつ、一番深い階層までがループされてフルパスが書き出され、
        'それが終わったらひと区切りで ”” （「1---」だけが）イミディエイトに出力される。
        s_PathChk = o_SubFoldr.Path
        Debug.Print g_i2 & "---" & s_PathChk
        
        '一番深い階層を終えたあとのさかのぼりのためのパスのチェック準備
        s_PathChk = o_SubFoldr.Path
            g_i2 = g_i2 + 1
    Next o_SubFoldr    '現在のフォルダのすべての階層のサブフォルダを終えると、何故か直前の「Call」以降の行とEnd Function を行ったり来たりして、いったん１つ上の階層のフォルダ代入されるが、結局そこもすでに完了しているためか、同じ階層の「次の」サブフォルダに移動。そこも終わっていればさりに上の階層に戻る。全部戻ったら、ルートの次のサブフォルダに移動。
  
  
  
    '一番深い階層を終えたあとのさかのぼりのためのパスの調査。
    Debug.Print g_i2 & "---" & s_PathChk

            '※「For Next 」のブロックを、ファイル一覧書き出しの前にもっていくと、
            '   この「さかのぼり」のタイミングで一覧書き出しになってしまうので、
            '   それで、「一番深い階層」から、ファイルが昇順に書き出される。

 
End Function 'ここで、s_PathChkがいったん ””になる。すべてさかのぼってルートに戻ると、For Each の「Call」の行へいく。そして、次のルートのサブフォルダの全階層の一覧書き出しが始まる。


'
'

'######################################################################

'すべてのファイルのフルパスを再帰的に（サブフォルダの中も全部、調べる。

'そして、セル（A列）に書き出す。

'######################################################################

Function RecursiveLoop01(s_FldPath As String)

Dim s_Trg01 As String

Dim o_SubFoldr As Object

Dim o_Fso01 As Object

Dim s_PathChk As String

g_i2 = 1

'以下のブロックを「サブフォルダ調査・取得。」よりも先にやると

'昇順に深い階層の曽部フォルダへときれいに並ぶ。

'後にやると、フォルダの並びが逆順になる。

'ファイルの並びは昇順。

'これは、全部をFSOでやった場合も同じ。

s_Trg01 = Dir(s_FldPath & "\*.*") 'フォルダが確定され、最初のファイル名が変数に代入されます。

Do While s_Trg01 <> "" '全部のファイルを処理し、処理し終わったら次のディレクトリ（サブフォルダ）へ行って、このループ（ファイル名のみの一覧表示）を行う。

g_i = g_i + 1

Activesheet.Cells(g_i, 1) = s_FldPath & "\" & s_Trg01 'シートへのフルパスの書き出し。

s_Trg01 = Dir() '現在のフォルダ「のみ」の、次のファイル名が１ループにつき、１つずつ、順番に入る。全部終わると ”” が入る。

Loop

'↑基本、ここまでが実行されます。

'　サブフォルダもここまでが実行されます。

'　つまり、サブフォルダに移動してから、

'　以降のコードで再帰呼び出しにて、

'　そのルートのファイル名だけをシートに書き出し、

'　それを全部のフォルダでやる・・・というイメージです。

'サブフォルダ調査・取得。

's_FldPathの中にサブフォルダがあったら

'そのサブフォルダを引数にして、

'自分自身(RecursiveLoop01)を再帰的に呼び出す。

Set o_Fso01 = CreateObject("Scripting.FileSystemObject") 'ひとつづつ下のフォルダに行くので、その都度、オブジェクト変数への代入が必要？

For Each o_SubFoldr In o_Fso01.GetFolder(s_FldPath).SubFolders '現在の階層の最初のサブフォルダを処理し、終わったら、更に下の階層のサブフォルダを覗きに行く。

'サブフォルダが無くなると、いったんFor Each を抜けて次の行へ行き、はじめにEnd Functionまで行き、（理由はわからないが）またFor Eachの中に戻り、でも、「Callの次の行」とEnd Function を、さかのぼりが終わるまで行ったり来たりする。

'自分自身の再帰的な呼び出しをしてサブフォルダを調査。

Call RecursiveLoop01(o_SubFoldr.Path)

'一番最初の ””がイミディエイトに出力されるタイミングは、

'ルートのサブフォルダがひとつずつ、一番深い階層までがループされてフルパスが書き出され、

'それが終わったらひと区切りで ”” （「1---」だけが）イミディエイトに出力される。

s_PathChk = o_SubFoldr.Path

Debug.Print g_i2 & "---" & s_PathChk

'一番深い階層を終えたあとのさかのぼりのためのパスのチェック準備

s_PathChk = o_SubFoldr.Path

g_i2 = g_i2 + 1

Next o_SubFoldr '現在のフォルダのすべての階層のサブフォルダを終えると、何故か直前の「Call」以降の行とEnd Function を行ったり来たりして、いったん１つ上の階層のフォルダ代入されるが、結局そこもすでに完了しているためか、同じ階層の「次の」サブフォルダに移動。そこも終わっていればさりに上の階層に戻る。全部戻ったら、ルートの次のサブフォルダに移動。

'一番深い階層を終えたあとのさかのぼりのためのパスの調査。

Debug.Print g_i2 & "---" & s_PathChk

'※「For Next 」のブロックを、ファイル一覧書き出しの前にもっていくと、

' この「さかのぼり」のタイミングで一覧書き出しになってしまうので、

' それで、「一番深い階層」から、ファイルが昇順に書き出される。

End Function 'ここで、s_PathChkがいったん ””になる。すべてさかのぼってルートに戻ると、For Each の「Call」の行へいく。そして、次のルートのサブフォルダの全階層の一覧書き出しが始まる。

投稿タグ: 「ニセモノ」への道, 「本物」に近づくために, AccessVBA, Accessの独学, ExcelVBA, Excelの独学, パソコンでの自動化, マクロ, 独学, 自動化

MENU

関連記事

最近の投稿

カテゴリー

MENU

Access2000VBA・Excel2000VBA独学～フォルダの中に含まれる全てのファイルを（全てのサブフォルダの中も全部）再帰的に順に編集するサンプルプログラム～

関連記事

最近の投稿

カテゴリー

タグ