[ExcelVBA] 再帰処理 - サブフォルダ内のファイル

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 20日目

再帰処理といえば、ある一定の処理が繰り返し
樹木の枝のように発生する場合に使う処理ですね。

例えば、サブフォルダ内のファイルを検索する場合



該当するファイルを探すという行為をフォルダを見つけるたびに１階層下に移動し繰り返しているだけですよね。
こういったパターンの時に使えますね。
他の例だと、クイックソートとかも使いどころですよね。

まずは、再帰処理を使う必要がないくらい単純な例を使って実際に使ってみましょう。
では、１０カウントダウンする関数を考えてみます。

普通に書くと、以下のように書けば実現できます。

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Call CountDown(10)  
5. End Sub  
6.   
7. Sub CountDown(ByVal num As Integer)  
8.     Dim i As Integer  
9.       
10.     For i = num To 1 Step -1  
11.         Debug.Print i  
12.     Next  
13. End Sub  

Option Explicit

Sub SampleCode()
    Call CountDown(10)
End Sub

Sub CountDown(ByVal num As Integer)
    Dim i As Integer
    
    For i = num To 1 Step -1
        Debug.Print i
    Next
End Sub

これと同様のことを再帰処理で実現すると…

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Call CountDown(10)  
5. End Sub  
6.   
7. Sub CountDown(ByVal num As Integer)  
8.     Debug.Print num  
9.     If 1 < num Then Call CountDown(num - 1)  
10. End Sub  

Option Explicit

Sub SampleCode()
    Call CountDown(10)
End Sub

Sub CountDown(ByVal num As Integer)
    Debug.Print num
    If 1 < num Then Call CountDown(num - 1)
End Sub

シンプルですねぇ。 これは、カウントするという行為を１０回繰り返していて 値だけが変わっているということに着目して書き換えたものです。 ただ、fot文で簡単にかけちゃうといまいち再帰処理のメリットを感じませんね そんなわけで、実際にサブフォルダ内のファイルを探すプログラムあたりを 書いてみると再帰処理のよさを感じられると思うので実際に書いてみるとよいと思います。 参考までに、自分が作成した関数を掲載しておきます。

view plainprint?

1. Option Explicit  
2.   
3. Function GetSubFolder(ByRef FilePaths As Object, ByVal CurrentFolder As String, Optional ByVal NameRule As String = "*")  
4.     Dim FileName As String  
5.     Dim Folder   As Variant  
6.     Dim Folders  As Object  
7.     Dim FSO      As Object  
8.     Dim TopFlag  As Boolean  
9.       
10.     '** Objectの生成 **  
11.     Set FSO = CreateObject("Scripting.FileSystemObject")  
12.       
13.     '存在しないパスのときは、関数を抜ける  
14.     If Not FSO.FolderExists(CurrentFolder) Then Exit Function  
15.       
16.     '該当するファイルの取得  
17.     FileName = Dir(CurrentFolder & "\" & NameRule)  
18.       
19.     Do While FileName <> ""  
20.           
21.         FilePaths.Add CurrentFolder & "\" & FileName, FileName  
22.         FileName = Dir()  
23.       
24.     Loop  
25.   
26.     'サブフォルダの処理  
27.     Set Folders = FSO.GetFolder(CurrentFolder)  
28.       
29.     'サブフォルダを一つずつループで処理する  
30.     For Each Folder In Folders.SubFolders  
31.           
32.         'さらにその下の階層を調べる  
33.         Call GetSubFolder(FilePaths, Folder.Path, NameRule)  
34.       
35.     Next  
36.   
37.     Set FSO = Nothing  
38.     Set Folders = Nothing  
39. End Function  
40.   
41. '実際に使ってみる  
42. Sub SampleCode()  
43.     Dim CurrentFolder As String  
44.     Dim FilePath      As Variant  
45.     Dim FilePaths     As Object  
46.       
47.     '** Objectを生成 **  
48.     Set FilePaths = CreateObject("Scripting.Dictionary")  
49.       
50.     '引数  
51.     '第一引数：見つかったパスを格納するDictionary  
52.     '          Dictionaryはキーにフルパス、値にファイル名  
53.     '第二引数：検索開始のフォルダパス  
54.     '第三引数：Dir関数同様に探しだすファイル名をアスタリスクを使って指定。  
55.       
56.     'ファイルを探し出すフォルダパス  
57.     CurrentFolder = "C:\Documents and Settings\Owner\My Documents\excel\test"  
58.       
59.     '検索開始  
60.     Call GetSubFolder(FilePaths, CurrentFolder, "*")  
61.   
62.     '検索結果を出力  
63.     For Each FilePath In FilePaths  
64.         Debug.Print "フルパス:" & FilePath  
65. '        Debug.Print "ファイル:" & FilePaths.Item(FilePath)  
66.     Next  
67.       
68.     Set FilePaths = Nothing  
69. End Sub  

Option Explicit

Function GetSubFolder(ByRef FilePaths As Object, ByVal CurrentFolder As String, Optional ByVal NameRule As String = "*")
    Dim FileName As String
    Dim Folder   As Variant
    Dim Folders  As Object
    Dim FSO      As Object
    Dim TopFlag  As Boolean
    
    '** Objectの生成 **
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    '存在しないパスのときは、関数を抜ける
    If Not FSO.FolderExists(CurrentFolder) Then Exit Function
    
    '該当するファイルの取得
    FileName = Dir(CurrentFolder & "\" & NameRule)
    
    Do While FileName <> ""
        
        FilePaths.Add CurrentFolder & "\" & FileName, FileName
        FileName = Dir()
    
    Loop

    'サブフォルダの処理
    Set Folders = FSO.GetFolder(CurrentFolder)
    
    'サブフォルダを一つずつループで処理する
    For Each Folder In Folders.SubFolders
        
        'さらにその下の階層を調べる
        Call GetSubFolder(FilePaths, Folder.Path, NameRule)
    
    Next

    Set FSO = Nothing
    Set Folders = Nothing
End Function

'実際に使ってみる
Sub SampleCode()
    Dim CurrentFolder As String
    Dim FilePath      As Variant
    Dim FilePaths     As Object
    
    '** Objectを生成 **
    Set FilePaths = CreateObject("Scripting.Dictionary")
    
    '引数
    '第一引数：見つかったパスを格納するDictionary
    '          Dictionaryはキーにフルパス、値にファイル名
    '第二引数：検索開始のフォルダパス
    '第三引数：Dir関数同様に探しだすファイル名をアスタリスクを使って指定。
    
    'ファイルを探し出すフォルダパス
    CurrentFolder = "C:\Documents and Settings\Owner\My Documents\excel\test"
    
    '検索開始
    Call GetSubFolder(FilePaths, CurrentFolder, "*")

    '検索結果を出力
    For Each FilePath In FilePaths
        Debug.Print "フルパス:" & FilePath
'        Debug.Print "ファイル:" & FilePaths.Item(FilePath)
    Next
    
    Set FilePaths = Nothing
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar