' カレントを起点として再帰的にファイル名を取得する
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
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 = "パス文字列"
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