odbc call failed 2147217887

[nille]

Sub ImportOldReg()
Dim cnn As ADODB.Connection, rsRec As ADODB.Recordset, rsFindRec As ADODB.Recordset
Dim sRecord As String, sFileName As String
Dim sRegrec As String, sPrNaam As String, sPrNummer As String, sArtNummer As String, sNaam As String, sTaak As String, sStartTijd As String, sEindTijd As String, sBetaal As String

Dim sFindRec As String
Dim sPrNewNaam As String
Dim sPrPlaats As String
Dim sPrVestiging As String
Dim bAdd As Boolean
Dim bGoOn As Boolean
Dim errorNotExistyet As Boolean

Dim fi As Long, iTeller As Long
Dim bBetaal As Boolean
fi = FreeFile
iTeller = 0
bAdd = False
bGoOn = True
errorNotExistyet = False

On Error GoTo err
sFileName = GetCfg("ImportPath") & "totaalrg.txt"
Set cnn = New ADODB.Connection
Set cnn = CurrentProject.Connection
Set rsRec = New ADODB.Recordset
    sRecord = "Registraties"
    rsRec.CursorType = adOpenKeyset
    rsRec.LockType = adLockOptimistic
    rsRec.Open sRecord, cnn, , , adCmdTable
If Dir(sFileName) <> "" Then
    Open sFileName For Input As fi
        While ((Not EOF(fi)) And bGoOn)
        'On Error Resume Next
            Line Input #fi, sRegrec
            sPrNaam = Trim(Mid(sRegrec, 1, 40))
            If Not (UCase(sPrNaam) = "INTERN") Then
                'hier layout nieuwe projecten opzoeken
                sFindRec = "SELECT * FROM Projecten"
                sFindRec = sFindRec & " WHERE OldProject ='" & sPrNaam & "'"
                'Set rsFindRec = Application.CurrentDb.OpenRecordset(sFindRec, , dbSeeChanges)
                Set rsFindRec = New ADODB.Recordset
                rsFindRec.CursorType = adOpenKeyset
                rsFindRec.LockType = adLockOptimistic
                rsFindRec.Open sFindRec, cnn, , , adCmdUnknown
                
                
                If rsFindRec.BOF And rsFindRec.EOF Then
                    bAdd = False
                    If Not (UCase(sPrNaam) = "INTERN") Then
                        'MsgBox "Project '" & sPrNaam & "' niet gevonden! Gelieve dit eerst aan te maken!"
                        errorNotExistyet = True
                    End If
                    'bGoOn = False
                Else
                    sPrNewNaam = rsFindRec!PrNaam
                    sPrPlaats = rsFindRec!PrPlaats
                    sPrVestiging = rsFindRec!PrVestiging
                    bAdd = True
                End If
                
                
                
                sPrNummer = Trim(Mid(sRegrec, 42, 20))
                sArtNummer = Trim(Mid(sRegrec, 63, 20))
                sNaam = Trim(Mid(sRegrec, 84, 40))
                sTaak = Trim(Mid(sRegrec, 125, 55))
                sStartTijd = Trim(Mid(sRegrec, 181, 17))
                sEindTijd = Trim(Mid(sRegrec, 199, 17))
                If (sEindTijd = "") Then sEindTijd = sStartTijd
                If (Mid(sRegrec, 217, 1) = "1") Then
                    'sBetaal = "Waar"
                    bBetaal = True
                Else
                    'sBetaal = "Onwaar"
                    bBetaal = False
                End If
                
                If bAdd Then
                    rsRec.AddNew
                    rsRec!PrNaam = Trim(sPrNewNaam)
                    rsRec!PrPlaats = Trim(sPrPlaats)
                    rsRec!PrVestiging = Trim(sPrVestiging)
                    rsRec!Persoon = Trim(sNaam)
                    rsRec!Taak = Trim(sTaak)
                    rsRec!StartTijd = sStartTijd
                    rsRec!EindTijd = sEindTijd
                    rsRec!Betalend = bBetaal
                    rsRec.Update                                   <------------------------------------------------------------------------------------------Plaats van begin FOUT!!!!!!!!!!!!!
                    iTeller = iTeller + 1
                    MsgBox (err.Description)
                End If
            End If
        Wend
        On Error GoTo 0
    Close #fi
    
    If bGoOn Then
        If Not CBool(errorNotExistyet) Then
            Kill sFileName
        End If
        MsgBox "Er zijn " & iTeller & " nieuwe registraties (oud formaat) toegevoegd!", vbInformation, "Import"
    End If
    
End If
Exit Sub
err:
MsgBox "ERROR:  " & err.Description & "-----" & err.Number

Can anyone help me please to solve this?

 

[nille]

Kan iemand mij hierbij helpen aub?