Conversiefout in toevoegquery

[BartSt]

Beste mensen,

In bijlage mijn database, met daarin "invoerformulier opleidingen", die de query "HLP_Q_Toevoegen_opleidingen" lanceert. Dat geeft, op het einde van de procedure, een fout. ("Niet alle records kunnen worden toegevoegd")

Wat loopt er mis?

Testbestand personeel.rar

[OctaFish]

Wat probeer je toe te voegen? En wat moeten al die overbodige tabellen in je toevoegquery?

[OctaFish]

Ik snap je query zoals gezegd niet helemaal, en bovendien heeft die als nadeel dat er geen check is op dubbel ingevoerde combinaties, al zou je dat met een Index nog wel kunnen oplossen. Zelf zou ik het dus anders doen, zonder die query, maar met recordsets die de gegevens ophalen en controleren.

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

In het eerste deel worden de op het subformulier geselecteerde records opgehaald, en in een matrix variabele gezet (iRegNum) op basis van [Tijdelijke selectie]=True. Vervolgens wordt de tabel [WN_Opleidingen(gevolgd)] voor alle deelnemers geopend met een filter op RegNum en Opleiding. Is het aantal 0, dan bestaat het record nog niet en wordt het toegevoegd, anders wordt de combinatie overgeslagen.
Met een lus wordt e.e.a. in de tabel toegevoegd.

[BartSt]

Ik wil een opleiding gevolgd door meerdere mensen kunnen toevoegen aan de tabel "WN_Opleidingen(gevolgd)" in één beweging. Per deelnemer moet er in die tabel een record worden toegevoegd.

De tabel heeft een gecombineerde primary key bestaande uit rijksregisternummer en startdatum. Ik veronderstel dat ik hiermee dubbele combinaties opvang.

Sommige opleidingen worden doorheen de jaren meerdere keren gevolgd, zoals EHBO. (Wettelijk verplicht om de zoveel jaren voor dezelfde medewerker.) Vandaar dat dezelfde opleidingen meerdere keren mag voorkomen bij dezelfde medewerker.

Ik moet eerlijk zeggen dat ik geen kennis heb van VBA, en dus niet weet wat ik met die code moet doen. (Als je code VBA is, tenminste ) Kan het ook worden opgelost m.b.v. standaard Access omgeving en/of SQL?

[BartSt]

Beste mensen,

In bijlage mijn database, met daarin "invoerformulier opleidingen", die de query "HLP_Q_Toevoegen_opleidingen" lanceert. Dat geeft, op het einde van de procedure, een fout. ("Niet alle records kunnen worden toegevoegd")

Wat loopt er mis?

Testbestand personeel.rar

Kan iemand mij helpen aub? Programmeren ken ik niet, SQL en standaard Access omgeving wel.

[BartSt]

Ik heb het aan de praat gekregen. Zoals Octafish zei was de recordset methode te verkiezen boven een toevoegquery. Waarvoor dank!

Voor de geïnteresseerden, de VBA code. (Met dank aan externe hulp ) Deze code laat dubbele combinaties rijksregisternummer en opleidingID toe.

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