Files
elwig-misc/wgmaster/vba/Form_MMitgliederKonsistenz.frm
2022-11-14 23:29:49 +01:00

134 lines
3.9 KiB
Plaintext

Dim temptablename1 As String
Private Sub Form_Open(Cancel As Integer)
Dim db1 As Database
LMitglieder.RowSource = ""
LMitglieder.Requery
temptablename1 = "xTempMitgliederInkonsistent"
Set db1 = CurrentDb
If TableExists(temptablename1) Then
db1.Execute ("DROP TABLE " + temptablename1)
End If
db1.Execute ("CREATE TABLE " + temptablename1 + " (MGNR LONG, ProblemKurz TEXT, Problem MEMO);")
FlaechenbindungenBerechnen (year(Now))
CheckConsistency
LMitglieder.RowSource = "SELECT TMitglieder.MGNR AS MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Ort, TMitglieder.Geschäftsanteile1 AS GA1, TMitglieder.Geschäftsanteile2 AS GA2, TMitglieder.Eintrittsdatum AS Eintritt, TMitglieder.Austrittsdatum AS Austritt, TMitglieder.[Aktives Mitglied] AS Aktiv, xTempFlaechenbindungen.Gesamtflaeche AS Flaeche, xTempMitgliederInkonsistent.ProblemKurz AS Problem FROM (TMitglieder INNER JOIN xTempMitgliederInkonsistent ON TMitglieder.MGNR = xTempMitgliederInkonsistent.MGNR) LEFT JOIN xTempFlaechenbindungen ON TMitglieder.MGNR = xTempFlaechenbindungen.MGNR ORDER BY TMitglieder.MGNR"
LMitglieder.Requery
End Sub
Function TableExists(table1) As Boolean
Dim db1 As Database
Set db1 = CurrentDb
Dim x As TableDef
For Each x In db1.TableDefs
If x.Name = table1 Then
TableExists = True
Exit Function
End If
Next x
TableExists = False
End Function
Sub CheckConsistency()
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim aktlesejahr As Long
Set db1 = CurrentDb
Set rs2 = db1.OpenRecordset(temptablename1)
Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE Austrittsdatum<>Null and [Aktives Mitglied]=true")
While Not rs1.EOF
rs2.AddNew
rs2("MGNR") = rs1("MGNR")
rs2("ProblemKurz") = "AUSTRITTSDATUM ABER AKTIV"
rs2("Problem") = "Mitglied hat Austrittsdatum eingetragen und ist trotzdem als aktiv eingetragen"
rs2.Update
rs1.MoveNext
Wend
rs1.Close
Set rs1 = db1.OpenRecordset("SELECT TMitglieder.MGNR FROM TMitglieder INNER JOIN xTempFlaechenbindungen ON TMitglieder.MGNR = xTempFlaechenbindungen.MGNR WHERE [Aktives Mitglied]=false and Gesamtflaeche>0")
While Not rs1.EOF
rs2.AddNew
rs2("MGNR") = rs1("MGNR")
rs2("ProblemKurz") = "FLÄCHENBINDG TROTZ INAKTIV"
rs2("Problem") = "Mitglied ist als nicht aktiv eingetragen, es sind aber noch gültige Flächenbindungen vorhanden"
rs2.Update
rs1.MoveNext
Wend
rs1.Close
Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE (Geschäftsanteile1>0 or Geschäftsanteile2>0) and [Aktives Mitglied]=false")
While Not rs1.EOF
rs2.AddNew
rs2("MGNR") = rs1("MGNR")
rs2("ProblemKurz") = "GA TROTZ INAKTIV"
rs2("Problem") = "Mitglied ist als nicht aktiv eingetragen, hat aber Geschäftsanteile eingetragen"
rs2.Update
rs1.MoveNext
Wend
rs1.Close
If Month(Now) < 11 Then
aktlesejahr = year(Now) - 1
Else
aktlesejahr = year(Now)
End If
Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE [Aktives Mitglied]=True AND MGNR NOT IN (SELECT DISTINCT MGNR FROM TLieferungen WHERE Year([Datum])>=" + Format(aktlesejahr - 2) + ")")
While Not rs1.EOF
rs2.AddNew
rs2("MGNR") = rs1("MGNR")
rs2("ProblemKurz") = "3 JAHRE KEINE LIEFERUNG"
rs2("Problem") = "Mitglied ist als aktiv eingetragen, hat aber bereits 3 Jahre hintereinander nichts geliefert"
rs2.Update
rs1.MoveNext
Wend
rs1.Close
Set rs1 = db1.OpenRecordset("SELECT MGNR FROM TMitglieder WHERE Austrittsdatum=NULL and [Aktives Mitglied]=false")
While Not rs1.EOF
rs2.AddNew
rs2("MGNR") = rs1("MGNR")
rs2("ProblemKurz") = "KEIN AUSTRITTSDATUM"
rs2("Problem") = "Mitglied hat kein Austrittsdatum eingetragen und ist nicht als aktiv eingetragen"
rs2.Update
rs1.MoveNext
Wend
rs1.Close
rs2.Close
End Sub
Private Sub LMitglieder_DblClick(Cancel As Integer)
DoCmd.OpenForm "FMitglieder", , , "MGNR=" + Format(LMitglieder)
Forms("FMitglieder")!OAlleMitglieder = True
Forms("FMitglieder").RequeryListe
Forms("FMitglieder")!LMitglieder = LMitglieder
End Sub