Get Bulk data from Excel into Access Table using VB??

[EhWot]

Help!

Apolologies for the protracted nature of this..

I need to get a load of data from an Excel Spreadsheet into an Access table on a daily basis. The Excel Column headings remain constant thought the actual data will change. The Excel Column formats include Text, Date and Number types.

I would normally just import this sheet using the Access Wizard, however I have a number of 'Problem' Fields that have mixed data types, i.e. Text and Numbers in the same Excel column (E.g. 12345 and 12345A). This is fine if the first 8 rows of excel data is Text: the Access destination Table is set to 'Text' and all rows are included in the Access Table, however if there are numbers in the first 8 Excel Rows then the imortation process treats that column as Text and will delete any Number entries.

I've tried formatting the Excel sheet before input and anything else I can think of but to no avail, so I resorted to code. The following opens the sheet (R394.xls)and cycles through the Access Table (tblImport) adding rows and setting each cell to equal it's counterpart in the Excel sheet. Works quite well for relatively small Excel sheets but the sheet in question has around 4000 rows and the process takes about 10 minutes. As our users attention span is les sthan 10% of that I need a way to speed this up.

So:

Can you 'Copy' whole rows at a time? if so how?

Is there any way of selecting the Access Table programatically so I can just do a Copy paste?

Any other ideas of how to do this?


Any help would be greatly appreciated as I'm supposed to be going live with this next week!

Code follows:

(Apologies for the amateur/untidy code but I've not been coding long)..

Private Sub Command0_Click()

'---------------------Open R394.XLS---------
DoCmd.Hourglass True
Dim db As Database
Set db = CurrentDb()

Dim objXL As Object  ' Variable to hold reference
    ' to Microsoft Excel.
    
Dim myPath
myPath = "O:\Procurement\Greg\Gregstuff\Misc\RequirementsDbase\R394.xls"

On Error Resume Next

Set objXL = GetObject(myPath, "Excel.Sheet").ActiveSheet

If Err.Number = "-2147467259" Then MsgBox "An _
Instance of the R394 Report was already open. You _
have elected to use this Instance for Import.",vbInformation

objXL.Application.Visible = True

objXL.Parent.Windows(1).Visible = True

'----------------------Data Manipulation--------------------

Dim ID2 As Integer

objXL.Application.ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
ID2 = objXL.Application.ActiveCell.Row
        'Sets ID2 to value of last Row in Excel Data
MsgBox "ID2= " & ID2

objXL.Application.Range("A2").Select

Dim rs As Recordset
Dim i As Integer, j As Integer
Set rs = db.OpenRecordset("tblImport")

For j = 0 To ID2 'Cycle for 'ID2' rows

rs.AddNew
rs.Update

For i = 0 To 19 'There are 20 Colums in the Access table.
rs.MoveFirst
rs.Move j
rs.Edit

    rs.Fields(i).Value = objXL.Application.ActiveCell.Offset(j, i).Value
    rs.Update
    Next

Next

DoCmd.Hourglass False

'--------------------Close .xls-----------------------
objXL.Application.ActiveWorkbook.Save
objXL.Application.ActiveWorkbook.Close

Set objXL = Nothing 'Release Variable. 
          
End Sub