Populating a table from multiple spreadsheets

[Grunners]

All,

First of all my apologies if I've posted in the wrong place and not in the Excel forum. I do have a big problem however and am pretty desperate!

I have a folder with multiple .xls files in it. They're all named differently BUT they all have the same sheet structure.

What I need to do, if indeed it's possible, is to look at one cell, in one worksheet, in each of the spreadsheets and, write the value to a field in a table.

So open folder d:\Accounts, look inside MySpreadsheet1.xls, pick sheet name MySheet1, take the value of cell C4 and append it to an access table.
Then look inside MySpreadsheet2.xls, pick sheet name MySheet1, take the value of cell C4 and append it to the table.

There's hundreds of these spreadsheets and they can have any name. I.e. It’s not as simple as ‘MySpreadsheet1.xls’ through to ‘MySpreadsheet9999.xls’

Any ideas would be very much appreciated!

Thanks in advance.

 

[namliam]

Have a read in the Access help on the Dir and Filesearch commands... see if that gets you anywhere.

 

[Grunners]

Cheers Mailman - I'm looking now...

 

[Grunners]

This is a tough one. Would it be any simpler if I just wanted to say get me the value of cell C4 from worksheet1 in all of the files in a given folder?

 

[namliam]

No...

You have to use either the Dir or Filesearch functionality to find the filenames... So that is why I send you there first.... Without the filenames you cannot get anywhere.

 

[Grunners]

Well so far I've got the code below which will cycle through all the spreadsheets in a folder. Now to interrogate them...

Public Sub Run_XLS_Files()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit - need commdlg to select folder
.LookIn = "d:\01_Accounts_ARD_Oct 03"
.FileType = ".xls"

If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

MsgBox .FoundFiles(lCount)

wbResults.Close SaveChanges:=True

Next lCount
End If
End With

End Sub

 

[namliam]

Public Sub Run_XLS_Files()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Set wbCodeBook = ThisWorkbook

    With Application.FileSearch
        .NewSearch
         'Change path to suit - need commdlg to select folder
        .LookIn = "d:\01_Accounts_ARD_Oct 03"
        .FileType = ".xls"
        
            If .Execute > 0 Then 'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                                  
                 MsgBox .FoundFiles(lCount)
                                  
                 wbResults.Close SaveChanges:=True
             
                 Next lCount
            End If
    End With
    
End Sub

wbresults.Worksheets("SheetName").range("B2")

That should be self explaining isnt it?

And Uhm, please use the code tags! Much more readable code that way.

 

[Grunners]

Nearly!

Had to do it a slightly different way but it works a treat now. Thanks for your help Mailman - very much appreciated.

Code as follows should anyone else ever have to do this in a hurry:

Public Sub Run_XLS_Files()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim TaxDiff As String
Dim CoNo As String

on error resume next

Set wbCodeBook = ThisWorkbook

    With Application.FileSearch
        .NewSearch
         'Change path to suit - need commdlg to select folder
        .LookIn = "d:\My_Spreadsheet_Folder"
        .FileType = ".xls"
        
            If .Execute > 0 Then 'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                 
                 Sheets("Summary").Activate
                 CoNo = ActiveSheet.Range("A2").Value
                 
                 Sheets("Accounts").Activate
                 TaxDiff = ActiveSheet.Range("C18").Value
                 
                 MsgBox .FoundFiles(lCount)
                 MsgBox CoNo & "  -  " & TaxDiff
                 
                 'WRITE(APPEND) VARS TO TABLE HERE
                                                   
                 wbResults.Close SaveChanges:=True
                         
                 Next lCount
            End If
    End With
    
    Set wbResults = Nothing
    
    MsgBox "Finished!", vbInformation
    
End Sub

 

[namliam]

Small word of warning...

When using automation allways use the FULL code...
Sheets works directly but is unreliable, buggy and will cause problems.
however
wbResults.Sheets
Will work like a charm and never bother you.

Word to the wize: Always use the full code!

 

[Grunners]

I hear ya

Have amended the code as you've advised.