Option Compare Database
Option Explicit
Dim moDummy, moCountSelect As Integer, moSQL As String, moKeuze As Integer, moTrefAll As Boolean
Private Sub buCloseForm_Click()
On Error GoTo Err_buCloseForm_Click
DoCmd.Close
Exit_buCloseForm_Click:
Exit Sub
Err_buCloseForm_Click:
MsgBox Err.Description
Resume Exit_buCloseForm_Click
End Sub
Private Sub buFilterOff_Click()
TrefKiesA = 0
TrefKiesB = 0
TrefKiesC = 0
TrefKiesD = 0
TrefKiesE = 0
TrefKiesF = 0
TrefCountA = 0
TrefCountB = 0
TrefCountC = 0
TrefCountD = 0
TrefCountE = 0
TrefCountF = 0
End Sub
Private Sub buSelector_Click()
On Error Resume Next
Dim stDocName As String, stSeek As String, strLink As String
Dim DBS As Database, RST As Recordset
If TrefKiesA < 2 And TrefKiesB < 2 And TrefKiesC < 2 Or moKeuze < 1 Then
MsgBox "Je moet tenminste èèn Trefwoord selecteren!", vbCritical, "Selectie Uitvoeren"
Exit Sub
End If
stDocName = "FviTitelList"
moSQL = "SELECT * FROM SeekTitleQry WHERE [Choice] <> 0"
moDummy = ArtistSeek(moSQL, "Reset")
moKeuze = 0
'' Set First Group
If TrefCountA > 0 Then
moSQL = "SELECT * FROM SeekTitleQry WHERE [TrefID]=" & TrefKiesA
moDummy = ArtistSeek(moSQL, "Add")
moKeuze = moKeuze + 1
End If
If TrefCountB > 0 Then
moSQL = "SELECT * FROM SeekTitleQry WHERE [TrefID]=" & TrefKiesB
moDummy = ArtistSeek(moSQL, "Add")
moKeuze = moKeuze + 1
End If
If TrefCountC > 0 Then
moSQL = "SELECT * FROM SeekTitleQry WHERE [TrefID]=" & TrefKiesC
moDummy = ArtistSeek(moSQL, "Add")
moKeuze = moKeuze + 1
End If
If TrefCountD > 0 Then
moSQL = "SELECT * FROM SeekTitleQry WHERE [TrefID]=" & TrefKiesD
moDummy = ArtistSeek(moSQL, "Add")
moKeuze = moKeuze + 1
End If
If TrefCountE > 0 Then
moSQL = "SELECT * FROM SeekTitleQry WHERE [TrefID]=" & TrefKiesE
moDummy = ArtistSeek(moSQL, "Ignore")
End If
If TrefCountF > 0 Then
moSQL = "SELECT * FROM SeekTitleQry WHERE [TrefID]=" & TrefKiesF
moDummy = ArtistSeek(moSQL, "Ignore")
End If
strLink = "Choice =" & moKeuze
DoCmd.OpenForm stDocName, , , strLink
If TrefCountA > 0 Then
Forms!FviTitelList!ExplA = TrefKiesA.Column(1)
Forms!FviTitelList!ExplB = TrefKiesB.Column(1)
Forms!FviTitelList!ExplC = TrefKiesC.Column(1)
Forms!FviTitelList!ExplD = TrefKiesD.Column(1)
Forms!FviTitelList!ExplE = TrefKiesE.Column(1)
Forms!FviTitelList!ExplF = TrefKiesF.Column(1)
End If
With Form_FviTitelList
.SwitchScherm False
.Repaint
End With
''Forms!FviTitelList!Debug = strLink
''If CountTitel < 1 Then
'' MsgBox "Er is niets gevonden met deze combinatie van Trefwoorden!", vbExclamation, "Selectie Uitvoeren"
'' Me.FilterOn = False
''Exit Sub
''End If
End Sub
Private Function ArtistSeek(strSeek As String, Modus As String)
On Error Resume Next
Dim DBS As Database, RST As Recordset
Dim mySel As Integer
Set DBS = CurrentDb
Set RST = DBS.OpenRecordset(strSeek)
While Not RST.EOF
Select Case Modus
Case "Reset"
mySel = 0
Case "Ignore"
mySel = 999
Case Else
mySel = RST("Choice") + 1
End Select
RST.Edit
RST("Choice") = mySel
RST.Update
RST.MoveNext
Wend
RST.Close
DBS.Close
End Function
Private Sub Form_Load()
On Error Resume Next
TrefKiesA = 0
TrefKiesB = 0
TrefKiesC = 0
TrefKiesD = 0
TrefKiesE = 0
TrefKiesF = 0
TrefCountA = 0
TrefCountB = 0
TrefCountC = 0
TrefCountD = 0
TrefCountE = 0
TrefCountF = 0
moKeuze = 0
End Sub
Private Sub TrefKiesA_AfterUpdate()
On Error Resume Next
Me.TrefCountA = ""
If Me.TrefKiesA > 1 Then Me.TrefCountA = TrefWordCount(TrefKiesA)
moKeuze = 1
buSelector.SetFocus
End Sub
Private Sub TrefKiesA_DblClick(Cancel As Integer)
On Error Resume Next
moKeuze = 0
TrefKiesA = 0
TrefCountA = 0
End Sub
Private Sub TrefKiesB_AfterUpdate()
On Error Resume Next
TrefCountB = 0
If TrefKiesB > 1 Then TrefCountB = TrefWordCount(TrefKiesB)
moKeuze = 2
buSelector.SetFocus
End Sub
Private Sub TrefKiesB_DblClick(Cancel As Integer)
On Error Resume Next
moKeuze = 1
TrefKiesB = 0
TrefCountB = 0
End Sub
Private Sub TrefKiesC_AfterUpdate()
On Error Resume Next
TrefCountC = 0
If TrefKiesC > 1 Then TrefCountC = TrefWordCount(TrefKiesC)
moKeuze = 3
buSelector.SetFocus
End Sub
Private Sub TrefKiesC_DblClick(Cancel As Integer)
On Error Resume Next
moKeuze = 2
TrefKiesC = 0
TrefCountC = 0
End Sub
Private Sub TrefKiesD_AfterUpdate()
On Error Resume Next
TrefCountD = 0
If TrefKiesD > 1 Then TrefCountD = TrefWordCount(TrefKiesD)
moKeuze = 3
buSelector.SetFocus
End Sub
Private Sub TrefKiesD_DblClick(Cancel As Integer)
On Error Resume Next
moKeuze = 2
TrefKiesD = 0
TrefCountD = 0
End Sub
Private Sub TrefKiesE_AfterUpdate()
On Error Resume Next
TrefCountE = 0
If TrefKiesE > 1 Then TrefCountE = TrefWordCount(TrefKiesE)
moKeuze = 2
buSelector.SetFocus
End Sub
Private Sub TrefKiesE_DblClick(Cancel As Integer)
On Error Resume Next
moKeuze = 1
TrefKiesE = 0
TrefCountE = 0
End Sub
Private Sub TrefKiesF_AfterUpdate()
On Error Resume Next
TrefCountF = 0
If TrefKiesF > 1 Then TrefCountF = TrefWordCount(TrefKiesF)
moKeuze = 2
buSelector.SetFocus
End Sub
Private Sub TrefKiesF_DblClick(Cancel As Integer)
On Error Resume Next
moKeuze = 1
TrefKiesF = 0
TrefCountF = 0
End Sub
Private Function TrefWordCount(wordID As Long) As Integer
Dim DBS As Database, RST As Recordset, strSeek As String
strSeek = "SELECT * FROM MedTrefWrdQry WHERE [TrefID] =" & wordID
Set DBS = CurrentDb
Set RST = DBS.OpenRecordset(strSeek)
If RST.RecordCount > 0 Then
RST.MoveLast
TrefWordCount = RST.RecordCount
End If
RST.Close
DBS.Close
End Function
