Question : Import multiple Excel workbooks into a single Access Table

Hello,

I wrote a timesheet in Excel for my company.  Each Employee gets one Timesheet file per year.  This Excel file has 52 tabs (one for each week).  The user fills in their time each week and just saves the file.  I have a Master file (also an Excel Workbook) that I open at the end of each week and click my "import data" button, and it imports the data by opening each file in the "Timesheets" directory, scrolling through each tab, and pulling the necessary data into an array.  Then the array is output into this Master Excel file as one big table.

Our company is growing, so the data is getting pretty voluminous to hold in an Excel Workbook, so I want to try to import the data into Access (but I still want the Employees to use the Current Excel Spreadsheets.

Ok, the question:
How do I write code in Access that will:
1.  Open each Excel File in a directory
2.  Scroll though each worksheet in the File
3.  Pull the Data into an Access Table
4.  Close the Excel Workbook.

I’m using Access 2000.

Thanks for your help!

Answer : Import multiple Excel workbooks into a single Access Table

you can use a function like this


Function GetWorkbook()
Dim objWkBook As Excel.Workbook
Dim objSheet As Worksheet
Dim strWBname As String
Dim strWSname As String
Dim i As Integer
Dim intCount As Integer
Dim strFilename, TblName, TableName As String
Dim newFileName As String
On Error GoTo GetWorkbook_Err
                               
strFilename = "c:\Test.xls"
newFileName = Mid(Left$([strFilename], InStr(1, [strFilename], ".") - 1), 4)

TblName = newFileName
Set objWkBook = GetObject("" & strFilename & "")
strWBname = objWkBook.Name
'intCount = (objWkBook.Sheets.Count) - 1 ' use either of this two
intCount = (objWkBook.Sheets.Count)      ' this one works on mine
 

For i = 1 To (intCount)
Set objSheet = objWkBook.Sheets(i)
  strWSname = objSheet.Name
   
         DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "" & TblName & strWSname & "", strFilename, True, "" & strWSname & "!"
   
     
Next i

objWkBook.Application.Quit    
Set objWkBook = Nothing    
Set objSheet = Nothing

GetWorkbook_Exit:
   Exit Function
GetWorkbook_Err:
 '   Debug.Print i; intCount; strWSname
   MsgBox Err.Number & " " & Err.Description
   Resume GetWorkbook_Exit

End Function

This will move the excel files to your DB tables with names "Test(sheetname)"
To test;
Open the intermediate window and type
getworkbook and hit the enter key
Random Solutions  
 
programming4us programming4us