VBA_複数ファイルから単一ファイルへ転記

 


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