【VBA】複数ファイル から あるファイル へ転記

Question

前提・実現したいこと

■実現したいこと
転記元ファイルフォルダ内の全ファイルのF4セルから転記先ファイルへ転記したいです。
転記の際、転記先にはファイルごとに行を1行ずつ下に転記させたいです。

■フォルダ構成

│ 転記先.xlsm
│
└─転記元ファイル
├─A
│ A.xlsx
│
├─B
│ B.xlsx
│
└─C
C.xlsx

↑ A,B,Cフォルダは転記元ファイルフォルダ内にあります。A～C.xlsx もそれぞれA～Cフォルダの中にあります。

発生している問題・エラーメッセージ

■問題
- forEachループ処理のインデックスとして用意しているrowIndexがインクリメントされません。
ループ外でrowIndexを1で初期化して、
ループ内でrowIndexをインクリメントしているのですが、
常にrowIndexが1で初期化されています。

該当のソースコード

' カレントを起点として再帰的にファイル名を取得する
Sub getFileNameRecursively()
    Dim path As String
    path = ThisWorkbook.path & "\転記元ファイル"
    Call getFilesRecursively(path)
End Sub


' 再帰的にファイル名を取得する
Sub getFilesRecursively(path As String)
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim objFolder As folder
    Dim objFile As file
    
    ' GetFolder(フォルダ名).SubFoldersでフォルダ配下のフォルダ一覧を取得
    For Each objFolder In fso.GetFolder(path).SubFolders
        Call getFilesRecursively(objFolder.path)
    Next
    
    Dim rowIndex As Integer
    rowIndex = 1
    
    For Each objFile In fso.GetFolder(path).Files
        Call copyString(objFile, rowIndex)
Debug.Print (rowIndex)
        rowIndex = rowIndex + 1
Debug.Print (rowIndex)
    Next
    
End Sub


Function copyString(objFile As file, rowIndex As Integer) As Integer
    
    ' 転記元ブックをオブジェクト化する
    Dim wbOriginal As Workbook
    Application.Workbooks.Open objFile.path
    Set wbOriginal = ActiveWorkbook
    
    ' 転記先ブックをオブジェクト化する
    Dim wbDestination As Workbook
    Dim destinationPath  As String
    destinationPath = "C:\Users\ユーザ名\親\子\孫\転記先.xlsm"
    Application.Workbooks.Open destinationPath
    Set wbDestination = ActiveWorkbook
    
    ' 目的の値を取得する
    Dim target As String
    target = wbOriginal.Sheets(1).Range("F4")
    ' 転記元ファイルの(X,1)に入力する
    wbDestination.Sheets(1).Cells(rowIndex, 1) = target
    
    copyString = rowIndex
    
    ' 転記元ファイルを閉じる
    wbOriginal.Close
    
End Function

試したこと

実行した結果、転記先にはA1セルに値が転記(上書き)されました。

デバッグでは、
Debug.Print (rowIndex)
と記載し結果をイミディエイトウィンドウで確認したところ値が
1
2
1
2
1
2
と出力されました。

補足情報（FW/ツールのバージョンなど）

Excel2016
Windows10 home

Answer 1

いただいたアドバイスをもとに、次のようにrowIndexを外に出したところうまくいきました。

' カレントを起点として再帰的にファイル名を取得する
Sub getFileNameRecursively()
Dim path As String
path = ThisWorkbook.path & "\転記元ファイル"

Dim rowIndex As Integer
rowIndex = 1

Call getFilesRecursively(path, rowIndex)

End Sub

' 再帰的にファイル名を取得する
Sub getFilesRecursively(path As String, rowIndex As Integer)
Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim objFolder As folder
Dim objFile As file

' GetFolder(フォルダ名).SubFoldersでフォルダ配下のフォルダ一覧を取得
For Each objFolder In fso.GetFolder(path).SubFolders
    Call getFilesRecursively(objFolder.path, rowIndex)
Next

For Each objFile In fso.GetFolder(path).Files
    Call copyString(objFile, rowIndex)
    rowIndex = rowIndex + 1
Next

End Sub

(略)

Answer 2

再帰の中で初期化されているからでは？

Sub getFilesRecursively(path As String, rowIndex As Integer)

とやってrowIndexを持ち回るか、
関数内でなくグローバル変数に持つか、
いっそシートに書き出す時に最終行を求めるようにするか、
といったあたりが解決法だと思います。

Comments

[peto_123]

jinojiさま
ご回答ありがとうございます。
修正しましたところ、うまくいきました。
大変助かりました。
今後ともよろしくお願いいたします。