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

[CODE=vb]
Dim cn As ADODB.Connectio n
Dim oRs As New ADODB.Recordset
Dim cnAccess As ADODB.Connectio n
Dim rsAccess As New ADODB.Recordset


' Open Excel Connection
Set cn = New ADODB.Connectio n
With cn
.Provider = "Microsoft.Jet. OLEDB.4.0"
.ConnectionStri ng = "Data Source=C:\Test. xls;" & _
"Extended Properties=Exce l 8.0;"
.Open
End With

' Open Access Connection
Set cnAccess = New ADODB.Connectio n
With cnAccess
.Provider = "Microsoft.Jet. OLEDB.4.0"
.ConnectionStri ng = "Data Source=C:\Docum ents and Settings\krishn am\Desktop\Inte rcompany Consolidation.m db;"
.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, adLockOptimisti c
MsgBox rsAccess.Record Count

'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).V alue
Next
rsAccess.Update
oRs.MoveNext

Loop

End Sub

[/CODE]


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):

[B]Public Sub ReadInExcelSheet(szExcelFileName As String, szSheetName As String, szDestinationTableName As String) [/B]

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=" [B]& szExcelFileName & [/B]";" & _
    "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 [" [B]& szSheetName & [/B]"$]", cn, adOpenStatic
MsgBox oRs.RecordCount


' Load ADO Recordset with Access Data
rsAccess.Open "select * from " [B]& szDestinationTableName & [/B]", 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 TransferSpreadS heet of the Access.Applicat ion 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 TransferSpreadS heet 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....