vba 再帰呼び出し　初期化

Question

以下のコードは、あるフォルダのサブフォルダを取得して、サブフォルダの中にあるファイルを全て取得します。
その後、取得したファイル名をエクセルに貼り付けます。
貼り付け時は.a=55 Cells(a, 1)として、aの値を更新して55行目から行を1行づつずらして56行、57行と、貼り付けたいと思っています。
しかし、サブフォルダを取得するときに再帰を使っているので、毎回aの値が55に初期化させてしまい、55行目にしか貼り付けることができません。
aの値を更新して貼り付けたいです。
ご教授お願いします。


```
Sub FileSearch(path As String)

Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")

'サブフォルダ取得
For Each Folder In FSO.GetFolder(path).SubFolders
   Call FileSearch(Folder.path)
Next Folder


file_path = "C:\Users******\Desktop****"
book = Dir(file_path & "*テスト.xls*")
 

a = 55
'エクセルファイル取得
For Each File In FSO.GetFolder(path).Files

  If File.Name = Dir(path & "*テスト.xls*") Then
  'ここで貼り付け
  Workbooks(book).Worksheets("Sheet1").Cells(a, 1) = File.Name

  End If
Next File

End Sub
```

Accepted Answer

前々回の質問でhatena19さんが紹介してくださった
[サブフォルダを含めてファイル一覧を取得する（Dir関数の再帰呼び出し）：Excel VBA｜即効テクニック｜Excel VBAを学ぶならmoug](https://www.moug.net/tech/exvba/0060088.html)
を最後まできちんと読めばわかりますよ。

---
下記が参照URLに記載の内容の一部です。
```VBA
Sub Test()
　　cnt = 0
　　Call Sample3("C:\Work")
End Sub
```
cntをここで初期化し、Sample3に進んでいます。
この例ではcnt=54とすれば次から1を足されていくのでご希望のものになると思います。

Answer

```ExcelVBA
Option Explicit

'Microsoft Scripting Runtimeを参照設定して使用すること
Dim mFSO As FileSystemObject
Dim mRng As Range

Sub test()
    Dim strFolder As String
    Dim ix As Long
    
    'フォルダー選択指定
    If GetFolderPath(strFolder) = False Then Exit Sub
    '書き出しセル初期値
    Set mRng = Workbooks(Workbooks.Count).Worksheets(1).Range("A55")
    'FSO取得
    Set mFSO = New FileSystemObject
    
    'ファイルフルパス一覧取得
    GetFileList mFSO.GetFolder(strFolder), ix
End Sub

'フォルダの選択
Private Function GetFolderPath(ByRef sPath As String) As Boolean
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Title = "フォルダの選択"
        If .Show = True Then
            sPath = .SelectedItems(1)
            GetFolderPath = True
        End If
    End With
End Function

'ファイル一覧取得（サブフォルダ含む）
Private Function GetFileList(ByVal objFolder As Folder, ByRef i As Long) As Boolean
    Dim fo As Folder
    Dim fi As File
    
    For Each fo In objFolder.SubFolders
        GetFileList fo, i
    Next
        
    For Each fi In objFolder.Files
        If mFSO.GetExtensionName(fi) Like "xls?" Then
            i = i + 1
            With mRng(i, 1)
                .Worksheet.Hyperlinks.Add Anchor:=.Cells, _
                                          Address:=fi.Path, _
                                          TextToDisplay:=fi.Name
            End With
        End If
    Next
End Function


```

僕なら
Private Function GetFileList(ByVal sPath As String, ByRef i As Long) As Boolean
のように、セルの相対位置の値を、
次の呼び出すプロシージャに受け渡していきますかね。

あと、単にファイル名を一覧にしても、どこのフォルダーにあるかわからないので、
ハイパーリンクを挿入して、見つけたファイルを直接開けるようにしてみました。

それから、FSOを何度も取得したり開放したりすることは無駄かなと、
モジュールレベルで使えるように変数を宣言してみました。
もちろんセルの位置もモジュールレベルで宣言してもいいかと思います。

あと、同じ値を得るために同じDir関数を使うのも無駄です。
書いてるのは一言だけど、VBAで書いてないので見えないけど、
誰かが書いたプログラムを呼び出していることになるので、
同じ値を使うときは、変数に値を1回保持して、それを使いまわすといいと思います。

あと、せっかくFSOを使っているので、どうせならFSOをフル活用してもいいかなと思いました。
Dir関数の方が処理は速いらしいですが、コードを書くのに
FSOの方が使い便利がいいので。

※簡単な動作確認はしてますが、
もれなくリストアップされるかは確認してませんので、
間違いがないか自己責任でお願いします。

※コードに不具合があったので修正しました。

Answer

こんな感じではどうでしょうか。
```VBA
Option Explicit
'
Private pstrMyPath As String
Private plngLayer As Long
Private plngRowCount As Long
'
Function Test_Sample_Miniature()
    pstrMyPath = "C:	est"
    plngRowCount = 54
    plngLayer = 0
    Call 自己参照(pstrMyPath, plngLayer)
End Function
'
'***********************************************
'    ＜自己参照＞
'***********************************************
Function 自己参照(ByVal MyPath As String, ByVal intLayer As Integer)
    Dim fs As Object
    Dim MyFolders As Object
    Dim MyFiles As Object
    Dim fsObj As Object
    Dim MyObj As Object
    intLayer = intLayer + 1
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fsObj = fs.GetFolder(MyPath)
    For Each MyObj In fsObj.SubFolders
        plngRowCount = plngRowCount + 1
        Cells(plngRowCount, intLayer + 0) = MyObj.Name
        Cells(plngRowCount, intLayer + 1) = MyObj.DateCreated
        Cells(plngRowCount, intLayer + 2) = MyObj.DateLastAccessed
        Cells(plngRowCount, intLayer + 3) = MyObj.DateLastModified
        Call 自己参照(MyObj.Path, intLayer)
    Next
    For Each MyObj In fsObj.Files
        plngRowCount = plngRowCount + 1
        Cells(plngRowCount, intLayer + 0) = MyObj.Name
        Cells(plngRowCount, intLayer + 1) = MyObj.DateCreated
        Cells(plngRowCount, intLayer + 2) = MyObj.DateLastAccessed
        Cells(plngRowCount, intLayer + 3) = MyObj.DateLastModified
    Next
    Set fs = Nothing
End Function
```
(参考資料)
[https://teratail.com/questions/281147](https://teratail.com/questions/281147)

関連した質問