Dubbele invoer voorkomen

Status
Niet open voor verdere reacties.
Q

Quant

Gebruiker
Lid geworden
3 feb 2010
Berichten
22
Hallo,

Ik heb een routine gemaakt om cursisten op te voeren, ik doe dit middels een form met niet afhankelijke invulvelden (comboboxen en een datumveld).
Verder bewaar ik deze gegevens in een tabel waaruit ik later middels een query met andere tabellen een rapport genereer.
De routine die ik gemaakt heb bevat ook een zoekfunctie die ik bij jullie op het forum ben tegengekomen.
Deze zoekfunctie zou ik graag willen uitbreiden, zodat hij en de cursist checked en tevens kijkt of deze cursist deze cursus al heeft gedaan. Het veld waar hij tevens op moet checken heet CursistID en bevind zich ook in de tabel Cursussen.
Hier de code:

Option Compare Database

Function fZoekOp(CursusID As String) As Boolean
Dim fld As Object
With CurrentDb.OpenRecordset("Cursussen")
While Not .EOF And Not fZoekOp
For Each fld In .Fields
If fld.Value = CursusID Then
fZoekOp = True
Exit For
End If
Next
.MoveNext
Wend
End With
End Function

Private Sub Combo0_AfterUpdate()
If fZoekOp(Combo0) Then
MsgBox "Deze Cursus is reeds vastgelegd voor deze cursist"
End If
End Sub

Private Sub Form_Load()

End Sub

Private Sub Save_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strSQL As String
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Cursussen", dbOpenTable)
If IsNull(Combo2) Then
MsgBox "Er is geen Cursist gekozen"
Combo2.SetFocus
Exit Sub
End If
If IsNull(Combo0) Then
MsgBox "Er is geen Cursus gekozen"
Combo0.SetFocus
Exit Sub
End If
If IsNull(Datumeind) Then
MsgBox "Er is geen Datum ingevuld"
Datumeind.SetFocus
Exit Sub
End If
rs1.AddNew
rs1!CursistId = Combo2.Value
rs1!CursusID = Combo0.Value
rs1!Datum = Datumeind.Value
rs1.Update
Combo2.SetFocus
Combo2.Value = ""
Combo0.Value = ""
Datumeind.Value = ""
End Sub

Indien iemand een oplossing heeft laat het me weten.
 
Als je op een recordset wilt controleren, kan dat op een vergelijkbare manier, bijvoorbeeld met bijgaande functie:

Code: 
Function fCheck(Velden As String, Tabel As String) As Boolean
Dim fld As Object
Dim sVelden As String, sVeld() As String
Dim i As Integer

    If InStr(1, Velden, "|") > 0 Then
        sVeld = Split(Velden, "|")
        For i = LBound(sVeld) To UBound(sVeld)
            sVelden = sVelden & sVeld(i)
            If i < UBound(sVeld) Then sVelden = sVelden & ","
        Next i
    Else
        sVeld = Velden
    End If
    With CurrentDb.OpenRecordset("SELECT " & sVelden & " FROM " & Tabel)
        If .RecordCount > 0 Then fCheck = True
        .Close
    End With

End Function

Aanroepen met (bijvoorbeeld)
if fCheck(Me.CursistID & "|" & Me.Cursus, "tblCursussen") then
 
Hallo Octafish,

Bedankt voor jouw reactie, maar ik krijg nu de foutmelding:

The expression after update you entered as the event property setting produced the following error: Byref argument type mismatch.
The expression may not result in the name of a user-defined function, or [Event Procedure]
There may have been an error evaluating the function, event or macro.
Ik heb de Functie in de code geplaatst en de aanroep aangepast.

Option Compare Database

Function fCheck(Velden As String, Tabel As String) As Boolean
Dim fld As Object
Dim sVelden As String, sVeld() As String
Dim i As Integer

If InStr(1, Velden, "|") > 0 Then
sVeld = Split(Velden, "|")
For i = LBound(sVeld) To UBound(sVeld)
sVelden = sVelden & sVeld(i)
If i < UBound(sVeld) Then sVelden = sVelden & ","
Next i
Else
sVeld = Velden
End If
With CurrentDb.OpenRecordset("SELECT" & sVelden & " FROM " & "Table")
If .RecordCount > 0 Then fCheck = True
.Close
End With
End Function

'Function fZoekOp(CursusID As String) As Boolean
'Dim fld As Object
'With CurrentDb.OpenRecordset("Cursussen")
' While Not .EOF And Not fZoekOp
' For Each fld In .Fields
' If fld.Value = CursusID Then
' fZoekOp = True
' Exit For
' End If
' Next
' .MoveNext
' Wend
' End With
'End Function

Private Sub Combo0_AfterUpdate()
If fCheck(CursistID & "|" & CursusID, tblCursussen) Then
MsgBox "Deze Cursus is reeds vastgelegd voor deze cursist"
End If
End Sub

Private Sub Form_Load()

End Sub

Private Sub Save_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strSQL As String
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Cursussen", dbOpenTable)
rs1.AddNew
If IsNull(Combo2) Then
MsgBox "Er is geen Cursist gekozen"
Combo2.SetFocus
Exit Sub
End If
If IsNull(Combo0) Then
MsgBox "Er is geen Cursus gekozen"
Combo0.SetFocus
Exit Sub
End If
If IsNull(Datumeind) Then
MsgBox "Er is geen Datum ingevuld"
Datumeind.SetFocus
Exit Sub
End If
rs1!CursistID = Combo2.Value
rs1!CursusID = Combo0.Value
rs1!Datum = Datumeind.Value
rs1.Update
Combo2.SetFocus
Combo2.Value = ""
Combo0.Value = ""
Datumeind.Value = ""
End Sub
 
Kun je aangeven op welke plaats hij de fout ingaat?

Overigens vind ik je code niet helemaal logisch opgebouwd; je check op de comboboxen zou ik doen vóórdat je records gaat toevoegen:
Dus zoiets:

Code: 
Private Sub Save_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strSQL As String
    
    If IsNull(Combo2) Then
        MsgBox "Er is geen Cursist gekozen"
        Combo2.SetFocus
        Exit Sub
    End If
    If IsNull(Combo0) Then
        MsgBox "Er is geen Cursus gekozen"
        Combo0.SetFocus
        Exit Sub
    End If
    If IsNull(Datumeind) Then
        MsgBox "Er is geen Datum ingevuld"
        Datumeind.SetFocus
        Exit Sub
    End If
    Set db = CurrentDb()
    Set rs1 = db.OpenRecordset("Cursussen", dbOpenTable)
    rs1.AddNew
    rs1!CursistID = Combo2.Value
    rs1!CursusID = Combo0.Value
    rs1!Datum = Datumeind.Value
    rs1.Update
    rs1.Close
    
    Set rs1 = Nothing
    db.Close
    Set db = Nothing
    
    Combo2.SetFocus
    Combo2.Value = ""
    Combo0.Value = ""
    Datumeind.Value = ""

End Sub

En gebruik de volgende keer ook de CODE tag, zodat het wat leesbaarder wordt ;)
 
Hallo Michel,

Het gaat fout als ik de combobox selecteer om de betreffende cursus te kiezen, ik
heb dan al het cursistid gekozen.
De foutmelding is nu wel anders, ik heb de code even aangepast zoals jij voorstelde.
De foutmelding is nu:

Compile error: Byref argument type mismatch.

Code: 
Private Sub Combo0_AfterUpdate()
    If fCheck(CursistID & "|" & CursusID, tblCursussen) Then
       MsgBox "Deze Cursus is reeds vastgelegd voor deze cursist"
    End If
 End Sub
 
Kun je hem stap voor stapje doorlopen? ik vermoed dat hij problemen heeft met één van de velden. Dat zou kunnen betekenen dat hij in de functie blijft hangen.
 
Hallo Michel,

Ik had de "" vergeten bij "tblCursussen" maar ik krijg nu de foutmelding:

Compileerfout:
Toewijzen aan matrix is niet mogelijk.

Code: 
Function fCheck(Velden As String, Tabel As String) As Boolean
wordt geel gearceerd en in regel
Code: 
sVeld = Velden
wordt sVeld blauw gearceerd.
 
Laatst bewerkt:
Hallo Michel,

Als ik debug krijg ik meteen weer de error melding: "Compile error: Byref argument type mismatch"
De regel
Code: 
Private Sub Combo0_AfterUpdate()
wordt geel - en de regel eronder
Code: 
If fCheck(CursistID & "|" & CursusID, tblCursussen) Then
wordt tblCursussen blauw gearceerd.
 
Laatst bewerkt:
Hallo Michel,

Ik had de "" vergeten bij "tblCursussen" maar ik krijg nu de foutmelding:

Compileerfout:
Toewijzen aan matrix is niet mogelijk.

Code: 
Function fCheck(Velden As String, Tabel As String) As Boolean

wordt geel gearceerd en in regel
Code:

Code: 
sVeld = Velden

wordt sVeld blauw gearceerd.
 
Foutje van mij... :o

sVeld = Velden
Moet zijn:
sVelden = Velden
 
Hallo Michel,

Het programma stopt nu met de foutmelding:

"Run-time error 3141"
The select statement includes a reserved word or an argument name that is mispelled or missing, or the punctuation is incorrect.
De dbugger stopt dan bij:
Code: 
With CurrentDb.OpenRecordset("SELECT" & sVelden & " FROM " & Tabel)
 
Laatst bewerkt:
Als je deze tekst letterlijk gebruikt, kan dat wel kloppen:

With CurrentDb.OpenRecordset("SELECT" & sVelden & " FROM " & Tabel)

er moet nog een spatie bij:

With CurrentDb.OpenRecordset("SELECT " & sVelden & " FROM " & Tabel)
 
Hallo Michel,

Ook na deze aanpassing krijg ik nog dezelfde foutmelding:
"Run-time error 3141"
The select statement includes a reserved word or an argument name that is mispelled or missing, or the punctuation is incorrect.


Code:
With CurrentDb.OpenRecordset("SELECT " & sVelden & " FROM " & Tabel)
 
Kun je eens controleren welke bibliotheken je hebt geladen in VBA?

<Alt>+<F11>, <Extra>, <Verwijzingen>.
 
Hallo Michel,

Hier de bibliotheken:

Visual Basic for applications
Microsoft access 14.0 obj. lib
Ole automation
Microsoft office 14.0 Access database engine object library
 
Je moet in ieder geval de Microsoft DAO 3.6 Object Library nog laden. En de Microsoft ActiveX Data Objects 2.8 Object Library kan anders ook uitkomst bieden. Als je deze twee laadt, moet je er wel voor zorgen dat de DAO onder de ADO komt te staan.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan