Importing multiple sheets from a excel spreadsheet into multiple tables

[Harshe]

hello all,

I am trying to code, but i am just stuck after importing one sheet. so here is the gist of what i need help with.

In a workbook at the start of the year (january) i will have 4 sheets and these sheets will keep increasing to 12 when the month is december. so i want is, sheet 1 (named abc) should go into table 1 (named abc), sheet 2 (named def)should go into table 2 (named def), sheet 3 (named xyz) should go into table 3 (named xyz). then sheet 4 through the next sheets till sheet 12 (named balance1, balance2, abalance3...so on till balance12) should all go into one table 'table4' (named balance) and all these sheets should keep appending starting from 1 then 2 all the way to 12.

I am able to put one sheet into one table and below is the code....i need help with the other part of my requirement

Dim cn As ADODB.Connection
Dim oRs As New ADODB.Recordset
Dim cnAccess As ADODB.Connection
Dim rsAccess As New ADODB.Recordset
 
 
' Open Excel Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=C:\Test.xls;" & _
    "Extended Properties=Excel 8.0;"
    .Open
End With
 
' Open Access Connection
Set cnAccess = New ADODB.Connection
With cnAccess
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=C:\Documents and Settings\krishnam\Desktop\Intercompany Consolidation.mdb;"
    .Open
End With
 
 ' Load ADO Recordset with Excel Sheet1Data
 
oRs.Open "Select * from [abc$]", cn, adOpenStatic
MsgBox oRs.RecordCount
 
 
' Load ADO Recordset with Access Data
rsAccess.Open "select * from tbl_abc", cnAccess, adOpenStatic, adLockOptimistic
MsgBox rsAccess.RecordCount
 
'Synchronize Recordsets and Batch Update
Do While Not (oRs.EOF)
        rsAccess.AddNew
        For i = 0 To 11   -----11 columns in table 1
        rsAccess.Fields(i).Value = oRs.Fields(i).Value
        Next
        rsAccess.Update
        oRs.MoveNext
 
Loop
 
End Sub
 
 

please help me so that i can move forward...

[VBWheaties]

Your sheets names are used as table names in the SELECT.

Do you need an idea about how to write what you need?

I would make a sub routine and just call the subroutine for every sheet in the excel workbook.

Heres an example sub routine (bold is code I added):

 Public Sub ReadInExcelSheet(szExcelFileName As String, szSheetName As String, szDestinationTableName As String) 
 
Dim cn As ADODB.Connection
Dim oRs As New ADODB.Recordset
Dim cnAccess As ADODB.Connection
Dim rsAccess As New ADODB.Recordset
 
 
' Open Excel Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & szExcelFileName & ";" & _
    "Extended Properties=Excel 8.0;"
    .Open
End With
 
' Open Access Connection
Set cnAccess = New ADODB.Connection
With cnAccess
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=C:\Documents and Settings\krishnam\Desktop\Intercompany Consolidation.mdb;"
    .Open
End With
 
 ' Load ADO Recordset with Excel Sheet1Data
 
oRs.Open "Select * from [" & szSheetName & "$]", cn, adOpenStatic
MsgBox oRs.RecordCount
 
 
' Load ADO Recordset with Access Data
rsAccess.Open "select * from " & szDestinationTableName & ", cnAccess, adOpenStatic, adLockOptimistic
MsgBox rsAccess.RecordCount
 
'Synchronize Recordsets and Batch Update
Do While Not (oRs.EOF)
        rsAccess.AddNew
        For i = 0 To 11   -----11 columns in table 1
        rsAccess.Fields(i).Value = oRs.Fields(i).Value
        Next
        rsAccess.Update
        oRs.MoveNext
 
Loop
End Sub
 

[Harshe]

Thanks a lot for your quick reply. I am a newbee here. so i did see your comments, but i am not sure how this would work as All sheets do not have same number of columns. the piece of code that says 'Synchronize Recordsets and Batch Update' that was for only 1 sheet and not for all. so maybe i didnt understand what you were trying to say.

thanks.

Your sheets names are used as table names in the SELECT ...

[VBWheaties]

Thanks a lot for your quick reply. I am a newbee here. so i did see your comments, but i am not sure how this would work as All sheets do not have same number of columns. the piece of code that says 'Synchronize Recordsets and Batch Update' that was for only 1 sheet and not for all. so maybe i didnt understand what you were trying to say.

thanks.

You never said columns vary. If columns vary, your problem becomes more complex.

My solution would be to use TransferSpreadSheet of the Access.Application object. First, set a reference to Microsoft Access x.0 Object Library where x is the number corresponding to your version.

Then, here is an example of how I would do:

    Dim acc As Access.Application
 
    Set acc = New Access.Application
 
    acc.OpenCurrentDatabase "C:\MyData.MDB"   'replace with your mdb path
 
    acc.DoCmd.TransferSpreadsheet acImport, _                      
                                acSpreadsheetTypeExcel97, _                
                                "SpreadSheetName", _                   'Replace with name of the spread sheet
                                "C:\excelData.xls"  'replace with path of the xls file. 
 
    acc.Quit
    Set acc = Nothing
 

[Harshe]

Thanks for your reply....
i initially used the below code using TransferSpreadSheet to make it work, but my problem with that code was that it used up a lot of resources and after it imported some tabs, it used to give 'out of memory' error and hence my manager told me to write using different style. the code is as below...

 
Dim aryList() As String
Dim strTable, strJunk As String
Const acImport = 0
Const acSpreadsheetTypeExcel9 = 8
Set objAccess = CreateObject("Access.Application")
objAccess.OpenCurrentDatabase "C:\Documents and Settings\sanghvih\Desktop\December07_AccessOOBData_01_07_08\transferData.mdb"
 
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
 
strFileName = "C:\Documents and Settings\sanghvih\Desktop\December07_AccessOOBData_01_07_08\December07_AccessOOBData_01_07_08.xls"
 
Set objWorkbook = objExcel.Workbooks.Open(strFileName)
Set colWorksheets = objWorkbook.Worksheets
 
For Each objWorksheet In colWorksheets
    Set objRange = objWorksheet.UsedRange
    strworksheetname = objWorksheet.Name & "!" & objRange.Address(False, False)
    strsheet = ""
    strsheet = strworksheetname
    aryList = Split(strsheet, "!", , vbTextCompare)
    intupper = UBound(aryList)
    strJunk = ""
    strTable = ""
    For a = 0 To UBound(aryList)
        If a = UBound(aryList) Then
            strJunk = aryList(a)
        Else
            strTable = aryList(a)
        End If
    Next a
 
    If strTable = "All_GL_Accts" Then
        objAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
       "tbl_Chart_of_Accounts", strFileName, True, strworksheetname
    ElseIf strTable = "BU_Legal_Consol" Then
        objAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
       "tbl_Business_Units", strFileName, True, strworksheetname
    ElseIf strTable = "ELIM Sets" Then
        objAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
       "tbl_Elimination_Sets", strFileName, True, strworksheetname
 
    Else
        objAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
       "tbl_Ledger_Balances_Combined", strFileName, True, strworksheetname
    End If
 
Next
 
 
End Sub
 
 
 

Also each tab has around 18K rows to import....