Ho un problema con access e excel

[-->Notihng]

Dopo aver importato i dati da excel con vb ed essermi collegato ad access riesco a scrivere fino a quando non mi si blocca e mi manda questo messaggio di errore. Il record corrente risponde all'inizio o alla fine del file oppure è stato eliminato. Per eseguire loperazione richiesta è necessario disporre di un record corrente.
Come posso fare?
Grazie.

Option Explicit
Public rsx As New ADODB.Recordset
Public tabella As String
Public strcnn As String
Public cn As New ADODB.Connection
Public cnnstr As String
Public rs As New ADODB.Recordset
Private Sub Command1_Click()
Dim foglio1 As String
Dim constr As New ADODB.Connection
Set cn = New ADODB.Connection
Set rsx = New ADODB.Recordset
constr = "driver={microsoft excel driver (*.xls)};dbq=C:\Documents and Settings\pop\Documenti\ora.xls"
cn.Open (constr)
rsx.Open "Select * from[elenco docenti$]", cn, adOpenDynamic, adLockBatchOptimistic
rsx.MoveFirst
Do Until rsx.EOF
If rsx.Fields(0) <> " " Then
List1.AddItem UCase(rsx.Fields(0))
End If
rsx.MoveNext
Loop
Set rsx = Nothing
Set cn = Nothing
End Sub
Private Sub Command2_Click()
'Stringa di connessioner ad access---------------------------------------
Dim connacces As New ADODB.Connection
Dim cn1 As Connection
Set cn1 = New ADODB.Connection
Set rs = New ADODB.Recordset
connacces = "provider=microsoft.jet.oledb.4.0; data source=C:\Documents and Settings\pop\Documenti\database.mdb"
cn1.Open (connacces)
tabella = "Professori"
rs.Open "Select * from " & tabella, cn1, adOpenDynamic, adLockOptimistic
'Stringa di connessione ad excel--------------------------------------
Dim foglio1 As String
Dim constr As New ADODB.Connection
Set cn = New ADODB.Connection
Set rsx = New ADODB.Recordset
constr = "driver={microsoft excel driver (*.xls)};dbq=C:\Documents and Settings\pop\Documenti\ora.xls"
cn.Open (constr)
rsx.Open "Select * from[elenco docenti$]", cn, adOpenDynamic, adLockBatchOptimistic

Dim app As String
rsx.MoveNext
Do Until rsx.Fields(0) = "" And rsx.Fields(1) = ""
If rs.EOF Then rs.AddNew
If rsx.Fields(0) = "" Then
rs.Fields("materia") = rsx.Fields(1)
End If
If rsx(0) <> "" Then
rs.Fields("cognome") = rsx.Fields(0)
End If
rs.MoveNext
rsx.MoveNext
Loop
rs.Update
End Sub