Conversiefout in toevoegquery

Dim strSQL As String
Dim iOpl As Integer
Dim dtStart As Date, dtEind As Date
Dim iStart As Long, iEind As Long
Dim iRegNum() As Variant
Dim i As Integer, iAantal As Integer, x As Integer
Dim tmp

iOpl = Me.Keuzelijst_beschikbare_opleidingen.Value
dtStart = Me.StartdatumINVOER
dtEind = Me.EinddatumINVOER

iStart = CLng(dtStart)
iEind = CLng(dtEind)

strSQL = "SELECT Rijksregisternummer FROM [WN_Persoonsgegevens] WHERE [Tijdelijke selectie]=True"
With CurrentDb.OpenRecordset(strSQL)
    If .RecordCount > 0 Then
        .MoveFirst
        .MoveLast
        iAantal = .RecordCount
        .MoveFirst
        ReDim iRegNum(iAantal)
        Do While Not .EOF
            i = i + 1
            iRegNum(i) = .Fields("Rijksregisternummer").Value
            .MoveNext
        Loop
    End If
    .Close
End With
        
If i > 0 Then
    For x = LBound(iRegNum) To UBound(iRegNum)
        strSQL = "SELECT [Rijksregisternummer], [Opleiding Id], Startdatum, Einddatum, [Attest ok] " _
            & "FROM [WN_Opleidingen(gevolgd)]" & vbCrLf
        strSQL = strSQL & "WHERE [Rijksregisternummer]=" & iRegNum(x) & " AND [Opleiding Id]=" & iOpl
        With CurrentDb.OpenRecordset(strSQL)
            If .RecordCount = 0 Then
                .AddNew
                .Fields("Rijksregisternummer") = iRegNum(x)
                .Fields("[Opleiding Id]") = iOpl
                .Fields("Startdatum") = CDate(iStart)
                .Fields("Einddatum") = CDate(iEind)
                .Fields("[Attest ok]") = True
                .Update
            End If
        End With
    Next x
End If

Private Sub AddTrainingsVBA_Click()
On Error GoTo AddTrainingsVBA_Click_Err

'set up some variables
Dim frm As Form
Dim ctl As Control
Dim varItm As Variant
Dim intI As Integer
Dim lngloop As Long

'set up the connections for the recordsets

Dim cnn1 As ADODB.Connection
Set cnn1 = CurrentProject.Connection



'set up the recordset
Dim myRSTraining As New ADODB.Recordset
myRSTraining.ActiveConnection = cnn1

'-----
'To be able to use an ADODB recordset, you have to set a reference
'to the Microsoft ActiveX Data Objects library
'Extra-> vewijzingen-> Microsoft Active X Data Objects 2.8 aanvinken.
'----

'open the recordset based on the WN_opleidingen(gevolgd) table
myRSTraining.Open "[WN_opleidingen(gevolgd)]", , adOpenDynamic, adLockOptimistic

If IsNull(Me.StartdatumINVOER) Then
    MsgBox "Voer een startdatum in"
    Me.StartdatumINVOER.SetFocus
    Exit Sub
End If

If IsNull(Me.EinddatumINVOER) = True Then
    MsgBox "Voor een einddatum in"
    Me.EinddatumINVOER.SetFocus
    Exit Sub
End If

If IsNull(Me.Keuzelijst_beschikbare_opleidingen) = True Then
    MsgBox "Selecteer een training"
    Me.Keuzelijst_beschikbare_opleidingen.SetFocus
    Exit Sub
End If





'set the control to the employee list box
Set ctl = Me.Keuzelijst134

'check to make sure at least 1 employee has been selected otherwise return message

If ctl.ItemsSelected.Count > 0 Then
    'for each selected employee, add the training to the WN_opleidingen(gevolgd) table
    For lngloop = 0 To ctl.ItemsSelected.Count - 1
        With myRSTraining
            .AddNew
            !Rijksregisternummer = ctl.ItemData(ctl.ItemsSelected(lngloop))
            ![Opleiding ID] = Me.Keuzelijst_beschikbare_opleidingen
            !Startdatum = Me.StartdatumINVOER
            !Einddatum = Me.EinddatumINVOER
            ![Attest ok] = Me.Attest_ok
            .Update
        End With
    Next lngloop
    MsgBox "Opleiding succesvol toegevoegd!"
    Me.Keuzelijst134 = Null
    Me.StartdatumINVOER = Null
    Me.EinddatumINVOER = Null
    Me.Keuzelijst_beschikbare_opleidingen = Null
    Me.Attest_ok = False
    
    
Else
    'No rows have been selected
    MsgBox "Er zijn geen medewerkers geselecteerd"
End If

myRSTraining.Close
Set myRSTraining = Nothing


AddTrainingsVBA_Click_Exit:
    Exit Sub

AddTrainingsVBA_Click_Err:
    MsgBox Error$
    Resume AddTrainingsVBA_Click_Exit

End Sub