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.
codice: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

Rispondi quotando
