Read a file and creat a table - excel

Question

I'm looking for a help in a difficult mission.
I have more then 30.000 files in a especific folder (*\backup) in xl?? format and need to read the cell B4. I thought the better idea is use the VBA in Excel to read this specific cell for each file and write on a table A:B.

Answer 1

I believe the following should help you, just remember to amend the declaration for the destination Worksheet name and the full path to the folder where the Workbooks you want to read reside.
The code below will loop through your desired Directory/Folder and read all the files with an .xls* extension, get the value from the first Worksheet in cell B4 and pass this value to the destination worksheet.
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim wsDestination As Worksheet: Set wsDestination = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet where you want to aggregate the data.
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.CutCopyMode = False
myPath = "C:\backup\"
'set the full path to the folder you want to utilize, remember to add the last \
Last = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row
If Last >= 2 Then wsDestination.Range("A2:B" & Last).ClearContents
'clear the destination worksheet ready to aggregate again
myExtension = "*.xls*"
'Target File Extension (must include wildcard "*")
myFile = Dir(myPath & myExtension)
'Target Path with Ending Extention
Do While myFile <> ""
'Loop through each Excel file in folder
Set wb = Workbooks.Open(Filename:=myPath & myFile)
DoEvents
'Ensure Workbook has opened before moving on to next line of code
wsDestination.Cells(1, "A").Value = "Filename"
wsDestination.Cells(1, "B").Value = "Value From Cell B4"
NextRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
wsDestination.Cells(NextRow, "A").Value = myFile
wsDestination.Cells(NextRow, "B").Value = wb.Worksheets(1).Range("B4").Value
wb.Close SaveChanges:=False
'Close Workbook without Saving
DoEvents
'Ensure Workbook has closed before moving on to next line of code
myFile = Dir
'Next File
Loop
MsgBox "Transfer of Data Completed!", vbInformation, "Info"
'Message Box when tasks are completed
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub