Situatie: via een VBA functie in een ms access 2003 (idem 2007) kan men in een subformulier iemand selecteren en bij klikken van een button wordt in een “Tbl_Wachtlijst” een kolom “prior” hernummerd volgens een aantal criteria waaraan een record moet voldoen waardoor het mogelijk gemaakt wordt om records op hun juiste plaats te zetten. Eerste criterium is als de record is van iemand van de woonplaats zelf en het tweede criterium is de categorie. Tot daar toe gaat alles goed maar dan is het derde criterium de datum. Normaal zou de nieuwste datum onderaan de lijst moeten komen (de oudste aanvraag heeft nml voorrang op een jongere aanvraag) maar nu gebeurd dat ergens bovenaan .
Enig idee waar de fout zit?
Ik probeer de database ook nog eens te strippen zodat hij plaatsbaar is op dit forum.
Enig idee waar de fout zit?
Code:
Private Sub cmdToevoegen_Click()
'Zoek de correcte plaats:
'De gemeente heeft voorrang, gevolgd door categorie en dan volgens datum
Dim dbsCurrent As Database
Dim rs As Object
Dim currNr, currBVWoonplaats, PriorGemeente, reden As String
Dim currcat, currInst, currPrior, newPrior As Long
Dim currDatum As Date
Set dbsCurrent = CurrentDb
'geef de inwoners met dezelfde gemeente als de instelling prioriteit
Set rs = dbsCurrent.OpenRecordset("select IPlaats from Tbl_Instelling where IHuidig = true")
If (Not rs.EOF) Then
PriorGemeente = rs(0)
Else
MsgBox "Geen gemeente van de huidige instelling gevonden", vbExclamation
Exit Sub
End If
currNr = Me.SubWachtlijst_Niet_Actief.Form!Nr.Value
Set rs = dbsCurrent.OpenRecordset("select Instellingsnummer from Tbl_Wachtlijst where [Nr Wachtlijst] = '" & currNr & "'")
If (Not rs.EOF) Then
currInst = rs(0)
End If
Set rs = dbsCurrent.OpenRecordset("SELECT Prior, BVWoonplaats, [Datum aanvraag] as datum, Nz(Sorteernummer,6) as Sorteernr " & _
"FROM Tbl_Wachtlijst LEFT JOIN Categorie ON Tbl_Wachtlijst.Categorie = Categorie.Categorie " & _
"WHERE [Nr Wachtlijst] = '" & currNr & "'")
If (Not rs.EOF) Then
rs.MoveFirst
currPrior = rs("Prior")
currBVWoonplaats = rs("BVWoonplaats")
currBVWoonplaats = Nz(currBVWoonplaats, "Onbekend")
currDatum = rs("Datum")
currDatum = Nz(currDatum, Date)
currcat = rs("Sorteernr")
End If
Set rs = dbsCurrent.OpenRecordset("SELECT [Nr Wachtlijst], Prior, BVWoonplaats, [Datum aanvraag] as datum, Nz(Sorteernummer,6) as Sorteernr " & _
"FROM Tbl_Wachtlijst LEFT JOIN Categorie ON Tbl_Wachtlijst.Categorie = Categorie.Categorie " & _
"WHERE Prior > 0 ORDER BY Prior;")
rs.MoveFirst
Do While (Not rs.EOF)
newPrior = rs("Prior")
If (rs("BVWoonplaats") <> PriorGemeente And currBVWoonplaats = PriorGemeente) Then
Exit Do
End If
If ((rs("BVWoonplaats") = PriorGemeente And currBVWoonplaats = PriorGemeente) Or (rs("BVWoonplaats") <> PriorGemeente And currBVWoonplaats <> PriorGemeente)) Then
'volgens categorie
If (currcat < rs("Sorteernr")) Then
Exit Do
End If
If (currcat = rs("Sorteernr")) Then
'volgens datum
If (rs("datum") > currDatum) Then
Exit Do
End If
End If
End If
rs.MoveNext
Loop
Query = "update Tbl_Wachtlijst set Prior = Prior + 1 where Prior >= " & _
newPrior & " and instellingsnummer = " & currInst
dbsCurrent.Execute (Query)
Query = "update Tbl_Wachtlijst set Prior = " & newPrior & ", Act = true, Pas = false, Geschrapt = false " & _
" where [Nr Wachtlijst] = '" & currNr & "'"
dbsCurrent.Execute (Query)
reden = InputBox("Reden toevoeging:")
Query = "insert into Tbl_prioriteitwijzigingen([Nr wachtlijst],[Reden wijziging],[Datum wijziging],Instellingsnummer,Oude_PriorNr,Oude_Wachtlijst,Nieuwe_PriorNr,Nieuwe_Wachtlijst) " & _
"values('" & currNr & "','" & reden & "',#" & Format(Date, "mm/dd/yyyy") & "#," & currInst & ",0,'Passief'," & newPrior & ",'Actief')"
dbsCurrent.Execute (Query)
Me.SubWachtlijst_Actief.Requery
Me.SubWachtlijst_Geschrapt.Requery
Me.SubWachtlijst_Niet_Actief.Requery
End SubIk probeer de database ook nog eens te strippen zodat hij plaatsbaar is op dit forum.
VBA werkt volgens een amerikaanse datumnotatie, dus de manier waarop je de datum toevoegt, gaat niet werken. Voeg een extra constante toe, en verander de query in dit:
