VBA/Function to read data from a list of closed workbooks(dynamically)

[lianli34312]

Hello everyone,

I am recently working with some data analysis in my project. In my case I need to run a VBA that can automatically read the data from a list of closed excel workbook named from 1-80, in which the data i would like to read is store at cell F7 .

[/IMG]


I try to study the threads on internet and i come up with the following "function" :

Case	Factor
1	='D:\Data\FYP\[1.xlsx]Worksheet1'!$F$7
2	='D:\Data\FYP\[2.xlsx]Worksheet2'!$F$7

<tbody>
</tbody>

But how can i loop the so call "function" to look for all worksheet and return the value for me?

Thank you

 

[NdNoviceHlp]

U didn't say where U want the data. This will put it in sheet1 A!:A& whatever. HTH, Dave

Private Sub test()
Dim fso As Object, FolDir As Object, FileNm As Object, Cnt As Integer
On Error GoTo erfix
Set fso = CreateObject("scripting.filesystemobject")
Set FolDir = fso.GetFolder("D:\Data\FYP")
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" & "*" Then
workbooks.Open filename:=FileNm
Cnt = Cnt + 1
ThisWorkbook.Sheets("Sheet1").Range("A" & Cnt).Value = _
          workbooks(FileNm.Name).Sheets("sheet1").Range("F" & 7)
workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
Exit Sub
erfix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
End Sub

 

[lianli34312]

Finally i do it like this after referencing to your code
Thank for you help

Private Sub test()Range("A1:B500").ClearContents
Dim fso As Object, FolDir As Object, FileNm As Object, Cnt As Integer
On Error GoTo erfix
Set fso = CreateObject("scripting.filesystemobject")
Set FolDir = fso.GetFolder("D:\Data\FYP")
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" & "*" Then
  
    Application.DisplayAlerts = False
    UpdateLinks = True
  
Workbooks.Open Filename:=FileNm


    Application.DisplayAlerts = True


Cnt = Cnt + 1


ThisWorkbook.Sheets("Sheet1").Range("A" & Cnt).Value = _
          Workbooks(FileNm.Name).Sheets("Sheet11").Range("F" & 7)
                           
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
Exit Sub
erfix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
End Sub

 

[NdNoviceHlp]

I missed the Welcome to the Board! Thanks for posting your outcome. Dave

 

[lianli34312]

Actually the VBA didn't read the data by the ascending order(I have a set of data named from 1 to 80), may i know how to modify the loop in order to read it by the ascending order? Please

 

[NdNoviceHlp]

Not sure what U mean? Do U have 80 files? The data is going A1:A & whatever.. do U want this changed? Dave

 

[lianli34312]

Not sure what U mean? Do U have 80 files? The data is going A1:A & whatever.. do U want this changed? Dave

Yes, i do have 80 files

, but seems the excel doesn't read the data in order(1.xlsx, 2.xlsx, 3.xlsx......10.xlsx, 11.xlsx....80.xlsx)

 

[NdNoviceHlp]

Maybe this...

Private Sub test()
Range("A1:B500").ClearContents
Dim fso As Object, FileNm As Object, Cnt As Integer
On Error GoTo erfix
Set fso = CreateObject("scripting.filesystemobject")
Application.ScreenUpdating = False
For Cnt = 1 To 80
Set fso = CreateObject("scripting.filesystemobject")
'***change File path to your file
Set FileNm = fso.GetFile("D:\Data\FYP\" & CStr(Cnt) & ".xlsx")
Application.DisplayAlerts = False
UpdateLinks = True
Workbooks.Open Filename:=FileNm
ThisWorkbook.Sheets("Sheet1").Range("A" & Cnt).Value = _
          Workbooks(FileNm.Name).Sheets("Sheet11").Range("F" & 7)
                           
Workbooks(FileNm.Name).Close SaveChanges:=False
Next Cnt
Application.ScreenUpdating = True
Set fso = Nothing
Exit Sub
erfix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
End Sub

 

[lianli34312]

Thank you, it's works !

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave