Function maken_deelbestand()

Dim dbdatabase As Database
Dim t_statistiek, t_afwezig, t_aantal, Q_lot, q_afw_nu, t_controledatum, t_deelbestand As Recordset
Dim q_kandidaat As Recordset
Dim dagen, var_teller, antw, afw_nr, aantal_trek, aantal_rec, Teller, arr_teller As Long
Dim tot_vandaag, dagen_verschil, stat_nr, var_afwezignr, aantal As Long
Dim aanwezig, vandaag_afwezig As Boolean
Dim vw_voldaan As Integer
Dim einddatum, startdatum As Date
Dim sqlstring, where_str As String
Dim vandaag, dag As Date
Dim bladwijzer As Variant
Dim tabellen As TableDef

On Error GoTo Err_maken_deelbestand

 'Controleren of u vandaag al een bestand gemaakt hebt, indien wel wordt dat
 'aan de gebruiker medegedeeld
 Set dbdatabase = CurrentDb
 sqlstring = "SELECT STATISTIEK.Trek_datum, CONTROLEDATUM.afwezigheidnr, CONTROLEDATUM.commentaarnr FROM CONTROLEDATUM "
 sqlstring = sqlstring & "LEFT JOIN STATISTIEK ON CONTROLEDATUM.statistieknr = STATISTIEK.Statistieknr "
 sqlstring = sqlstring & "ORDER BY STATISTIEK.Trek_datum;"
 Set t_statistiek = dbdatabase.OpenRecordset(sqlstring)
 vandaag = Date
 If Not (t_statistiek.BOF) Then
   t_statistiek.MoveLast
   dag = t_statistiek.Fields![Trek_datum]
   If dag = vandaag Then
      antw = MsgBox(Chr(10) & Chr(13) & "U hebt vandaag reeds een controle-lijst gemaakt." & Chr(10) & Chr(13) & _
      "Wilt U doorgaan?", vbYesNo, "Melding")
      If antw = 7 Then
        Exit Function
      Else
        Set t_afwezig = dbdatabase.OpenRecordset("select afwezigheid_nr, contr_oproep from afwezig order by afwezigheid_nr")
        Do While dag = vandaag
          afw_nr = t_statistiek.Fields![afwezigheidnr]
          If t_statistiek.Fields![commentaarnr] = 1 Then
            t_afwezig.FindFirst "[afwezigheid_nr] = " & afw_nr
            If Not (t_afwezig.NoMatch) Then
              t_afwezig.Edit
              t_afwezig.Fields![Contr_oproep] = Empty
              t_afwezig.Update
            End If
          End If
          t_statistiek.MovePrevious
          If t_statistiek.BOF Then
            Exit Do
          Else
            dag = t_statistiek.Fields![Trek_datum]
          End If
        Loop
      End If
   End If
 End If
 t_statistiek.Close

 'Verwijderen van tabel deelbestand
 aanwezig = False
 For Each tabellen In dbdatabase.TableDefs
    If tabellen.Name = "Deelbestand" Then
      aanwezig = True
      Exit For
    End If
 Next
 If aanwezig Then
   dbdatabase.Execute "DROP TABLE [deelbestand];"
   dbdatabase.Close
 End If

 'bepalen hoeveel dagen tussen de opeenvolgende werkdagen zich bevinden (var_teller)
 dagen_verschil = 0
 dagen = 0
 einddatum = Date
 startdatum = Date - 1
 While (dagen <> 1)
   dagen = aantal_dagen(startdatum:=CDate(startdatum), einddatum:=Date)
   dagen_verschil = dagen_verschil + 1
   startdatum = startdatum - 1
   dagen = dagen - 1
 Wend

 'kijken of er vandaag afwezig zijn
 Set dbdatabase = CurrentDb
 Set q_afw_nu = dbdatabase.OpenRecordset("select stamnr from q_afwezig_nu")
 If q_afw_nu.BOF Then
   vandaag_afwezig = False
 Else
   vandaag_afwezig = True
 End If
 q_afw_nu.Close

 'personeelsleden die vandaag afwezig zijn worden in de pot gestoken
 'Set dbdatabase = CurrentDb
 'Randomize
 'sqlstring = "SELECT FREQUENTIE.Stamnr, Int(Rnd(frequentie.stamnr)*1000) AS Volgorde, Q_afwezig_nu.Controle_result AS "
 'sqlstring = sqlstring & "contrresult, Q_afwezig_nu.Controle_result2 INTO Deelbestand "
 'sqlstring = sqlstring & "FROM Q_afwezig_nu LEFT JOIN FREQUENTIE ON Q_afwezig_nu.Stamnr = FREQUENTIE.Stamnr;"
 If vandaag_afwezig Then
   sqlstring = "SELECT Q_afwezig_nu.Stamnr,Q_afwezig_nu.stamnr as Volgorde, Q_afwezig_nu.Controle_result AS "
   sqlstring = sqlstring & "contrresult, Q_afwezig_nu.Controle_result2 INTO Deelbestand "
   sqlstring = sqlstring & "FROM Q_afwezig_nu LEFT JOIN FREQUENTIE ON Q_afwezig_nu.Stamnr = FREQUENTIE.Stamnr;"
   dbdatabase.Execute sqlstring
   Set t_deelbestand = dbdatabase.OpenRecordset("select * from deelbestand")
   t_deelbestand.MoveFirst
   While Not (t_deelbestand.EOF)
     Randomize
     t_deelbestand.Edit
     t_deelbestand.Fields![volgorde] = Int(Rnd * 1000000)
     t_deelbestand.Update
     t_deelbestand.MoveNext
   Wend
   t_deelbestand.Close
 End If

 'tabel statistiek wordt aangevuld
 'Set dbdatabase = CurrentDb
 aanwezig = False
 For Each tabellen In dbdatabase.TableDefs
    If tabellen.Name = "Deelbestand" Then
      aanwezig = True
      Exit For
    End If
 Next
 If aanwezig Then
   Set t_deelbestand = dbdatabase.OpenRecordset("select stamnr from deelbestand")
   t_deelbestand.MoveFirst
   t_deelbestand.MoveLast
   tot_vandaag = t_deelbestand.RecordCount
   t_deelbestand.Close
 Else
    tot_vandaag = 0
 End If
 Set t_statistiek = dbdatabase.OpenRecordset("select * from statistiek")
 t_statistiek.AddNew
 t_statistiek.Fields![Tot_afwezig] = tot_vandaag
 t_statistiek.Update
 t_statistiek.MoveLast
 stat_nr = t_statistiek.Fields![Statistieknr]
 t_statistiek.Close
 If Not (vandaag_afwezig) Then
   MsgBox "Er zijn vandaag geen afwezigen!!", vbOKOnly, "Melding"
   Exit Function
 End If


 'De niet "J" in de controle van deelbestand verwijderen
  'dbdatabase.Execute "UPDATE deelbestand SET contrresult = '' WHERE contrresult = 'N';"
  'dbdatabase.Execute "UPDATE deelbestand SET controle_result2 = '' WHERE controle_result2 = 'N';"

 'aantal dat er getrokken moet worden
  Set dbdatabase = CurrentDb
  Set t_aantal = dbdatabase.OpenRecordset("select stamnr from deelbestand")
  t_aantal.MoveFirst
  t_aantal.MoveLast
  aantal_rec = t_aantal.RecordCount
  If (aantal_rec = 0) Then
    aantal_trek = 0
  Else
    If (aantal_rec Mod 5 = 0) Then
       aantal_trek = aantal_rec / 5
    Else
       aantal_trek = Int(aantal_rec / 5) + 1
    End If
  End If
  t_aantal.Close
  If (aantal_trek = 0) Then
    MsgBox "Er is geen controle vandaag !!", vbOKOnly
    Exit Function
  End If

 'array opvullen met stamnummers
  ReDim a(aantal_trek)
  ReDim opmerk(aantal_trek)
  Set Q_lot = dbdatabase.OpenRecordset("select volgorde, stamnr from Q_pot_volgorde")
  Teller = 1
  Q_lot.MoveFirst
  arr_teller = 1
  a(arr_teller) = Q_lot.Fields![Stamnr]
  Do While (Teller < aantal_trek)
    Q_lot.MoveNext
    If Q_lot.EOF Then
      aantal_trek = Teller
      Exit Do
    End If
    'For var_teller = 1 To teller
    '  If a(var_teller) = Q_lot.Fields![Stamnr] Then
    '     Exit For
    '  End If
    'Next var_teller
    'If (var_teller = teller + 1) Then
      arr_teller = arr_teller + 1
      a(arr_teller) = Q_lot.Fields![Stamnr]
    ' End If
    Teller = Teller + 1
  Loop
  Q_lot.Close

  'criteria met de verschillende stamnummers in de where string zetten
   where_str = "where ([Q_afwezig_nu]![Stamnr] = " & a(1) & ")"
   If aantal_trek > 1 Then
     For var_teller = 2 To aantal_trek
       If Nz(a(var_teller)) = "" Then
          Exit For
       End If
       For Teller = 1 To var_teller - 1
         If a(Teller) = a(var_teller) Then
           Exit For
         End If
       Next Teller
       If (Teller = var_teller) Then
          where_str = where_str & " or ([Q_afwezig_nu]![Stamnr] = " & a(var_teller) & ")"
       End If
     Next var_teller
   End If

  'openen van de query q_afwezig_nu
   sqlstring = "select * from Q_afwezig_nu " & where_str
   Set q_afw_nu = dbdatabase.OpenRecordset(sqlstring)

  'de getrokken worden in de tabel "controledatum" bijgehouden
   Set t_controledatum = dbdatabase.OpenRecordset("select * from controledatum")

  'records toevoegen van de getrokken in de tabel controledatum
   For var_teller = 1 To aantal_trek
     If Nz(a(var_teller)) = "" Then
       Exit For
     End If
     t_controledatum.AddNew
     t_controledatum.Fields![Stamnr] = a(var_teller)
     t_controledatum.Update
     q_afw_nu.MoveFirst
     q_afw_nu.FindFirst "[stamnr] = " & a(var_teller)
     bladwijzer = q_afw_nu.Bookmark
     var_afwezignr = q_afw_nu.Fields![Afwezigheid_nr]
     t_controledatum.MoveLast
     t_controledatum.Edit
     t_controledatum.Fields![afwezigheidnr] = var_afwezignr
     t_controledatum.Fields![Statistieknr] = stat_nr
     t_controledatum.Update
     vw_voldaan = 0
     'kijken of men reeds uitgeloot is en dat men al een controle resultaat heeft
     If Nz(q_afw_nu.Fields![Enddate]) = "" And Nz(q_afw_nu.Fields![Contr_oproep]) <> "" Then
       vw_voldaan = 6
     End If
     'kijken of men reeds de vorige werkdag geloot is
     q_afw_nu.Bookmark = bladwijzer
     vandaag = Date - dagen_verschil
     If IsNull(q_afw_nu.Fields![Contr_oproep]) Then
       dag = Date
     Else
       dag = q_afw_nu.Fields![Contr_oproep]
     End If
     If (dag = vandaag) Then
       vw_voldaan = 5
     End If
     'kijken of de afwezige al gecontroleerd is
     If Nz(q_afw_nu.Fields![Enddate]) <> "" Then
       vw_voldaan = 4
     End If
     'kijken of de afwezige verlenging is van ziekte
     If q_afw_nu.Fields![mogelijkheid verlenging (Gekoli)] = -1 Then
       vw_voldaan = 3
     End If
     'kijken of de afwezige vrijstelling heeft van controle
     If q_afw_nu.Fields![VRIJSTELLING] = -1 Then
       vw_voldaan = 2
     End If
     'bijvoegen van commentaarnr in tabel controledatum
     t_controledatum.MoveLast
     t_controledatum.Edit
     If vw_voldaan = 0 Then
       t_controledatum.Fields![commentaarnr] = 1
       opmerk(var_teller) = 1
     Else
       t_controledatum.Fields![commentaarnr] = vw_voldaan
       opmerk(var_teller) = vw_voldaan
     End If
     t_controledatum.Update
   Next
   t_controledatum.Close
   q_afw_nu.Close

   'toevoegen in tabel kandidaattrekkers
   sqlstring = "SELECT Deelbestand.Stamnr, Count(Deelbestand.Stamnr) AS frequentie FROM Deelbestand "
   sqlstring = sqlstring & "GROUP BY Deelbestand.Stamnr;"
   Set Q_lot = dbdatabase.OpenRecordset(sqlstring)
   Set q_kandidaat = dbdatabase.OpenRecordset("select * from kandidaattrekkers")
   Q_lot.MoveFirst
   Do While Not (Q_lot.EOF)
      q_kandidaat.AddNew
      q_kandidaat.Fields![Stamnr] = Q_lot.Fields![Stamnr]
      q_kandidaat.Fields![FREQUENTIE] = Q_lot.Fields![FREQUENTIE]
      q_kandidaat.Fields![Statistieknr] = stat_nr
      q_kandidaat.Update
      Q_lot.MoveNext
   Loop
   Q_lot.Close
   q_kandidaat.Close

  'zetten van controle datum nl. dag van vandaag, in afwezigheid nu
   Set q_afw_nu = dbdatabase.OpenRecordset("select stamnr, contr_oproep from Q_afwezig_nu")
   For var_teller = 1 To aantal_trek
     If Nz(a(var_teller)) = "" Then
        Exit For
     End If
     q_afw_nu.MoveFirst
     q_afw_nu.FindFirst "[stamnr] = " & a(var_teller)
     If q_afw_nu.NoMatch Then
       MsgBox "U moet de programmeur verwittigen (fout = 1)!", vbOKOnly, "Melding"
       Exit Function
     Else
       If opmerk(var_teller) = 1 Then
         q_afw_nu.Edit
         q_afw_nu.Fields![Contr_oproep] = Date
         q_afw_nu.Update
       End If
     End If
   Next var_teller
   q_afw_nu.Close

   'Wordt gevraagd of men de controle-lijst wilt zien
   antw = MsgBox(Chr(10) & Chr(13) & "De controle-lijst is aangemaakt." & Chr(10) & Chr(13) & _
          "Wilt U deze zien?", vbYesNo, "Vraag")
   If antw = 6 Then     'Ja
      controle_lijst
   End If

Exit_maken_deelbestand:
    Exit Function

Err_maken_deelbestand:

    MsgBox Err.Description & " " & Err.Number
    Resume Exit_maken_deelbestand
End Function