Using ADO to import from excel (HELP)

[3ddy]

I am able to make my connection to the excel file and
enter the first sheet into the table with no problem. It
goes to the second excel sheet then the system locks up on
record 64560 which is about record 4345 on the second
sheet. Am I missing something?

This is the code I'm running:

Private Sub Command0_Click()
Dim objExcel As ADODB.Connection
Dim strSQL As String
Dim objApp As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim rst As ADODB.Recordset
Dim intCount As Integer, intRows As Long
Dim strTableName As String
Dim cnn2 As New ADODB.Connection
Dim rst2 As ADODB.Recordset

Set cnn2 = CurrentProject.Connection
Set rst2 = New ADODB.Recordset

rst2.CursorType = adOpenStatic
rst2.LockType = adLockOptimistic
rst2.Open "tblLogs", cnn2


Set objApp = New Excel.Application
Set rst = New ADODB.Recordset

With objApp
.DisplayAlerts = False
.Visible = False
End With

strpath = "C:\WINDOWS\Desktop\Telephone Logs
Project\telephone log.xls"

Set objWB = objApp.Workbooks.Open(strpath)
Set objWS = objWB.Worksheets(1)
strTableName = objWS.Name

Set objExcel = New ADODB.Connection
objExcel.ConnectionString
= "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strpath & ";" &
_
"Extended Properties=Excel 8.0;"

strSQL = "SELECT * FROM [" & strTableName & "$]"

rst.Open strSQL, objExcel.ConnectionString, adOpenStatic,
adLockOptimistic, -1
intRows = rst.RecordCount
intSheets = objWB.Sheets.Count
pos = 1

x = 1 ‘used to display record
number currently writing on form

While (pos <= intSheets)
Do While Not rst.EOF
rst2.AddNew
rst2(1) = rst(0) ‘rst2(0) is an autonumber field
so don’t set it
rst2(2) = rst(1)
rst2(3) = rst(2)
rst2(4) = rst(3)
rst2(5) = rst(4)
rst2(6) = rst(5)
rst2(7) = rst(6)
rst2(8) = rst(7)
rst2.Update
rst.MoveNext
Me.txtRecord = x
Me.Repaint
x = x + 1
Loop
pos = pos + 1
rst.Close
Set rst = Nothing
Set objWS = objWB.Worksheets(pos)
strTableName = objWS.Name
strSQL = "SELECT * FROM [" & strTableName & "$]"
Set rst = New ADODB.Recordset
rst.Open strSQL, objExcel.ConnectionString,
adOpenStatic, adLockOptimistic, -1
Wend

Set objWS = Nothing
Set objWB = Nothing
objApp.Quit
Set objApp = Nothing
rst.Close
Set rst = Nothing

‘delete rows used for totals
DoCmd.RunSQL "DELETE tblLogs.Date FROM tblLogs WHERE
tblLogs.Date Is Null;"

End Sub


Another thing was that when I only tested it on one page,
it worked fine. After the code finished, if I pressed
alt+crtl+del, I would still see excel in the processes
running.

Any help on this would be GREATLY appreciated.