Option Explicit

Const CMD_NORMAL = 0
Const CMD_REF = 1
Const CMD_PARAM = 2
Const CMD_REST = 3

Sub cmdAktion_Click (Index As Integer)
'alle Command-Buttons sind als Array aufgebaut
Select Case Index
Case CMD_NORMAL
  Delete_Kunde (Val(Text1))
Case CMD_REF
  Delete_Kunde_2 (Val(Text1))
Case CMD_PARAM
  Delete_Kunde_3 (Val(Text1))
Case CMD_REST
  Copy_Tabelle
End Select
'Daten haben sich geändert
data1.Refresh
End Sub

Sub Copy_Tabelle ()

Dim QDelete As Querydef
'wiederherstellen der Tabellen in den Originalzustand
'dazu zuerst Original-Tabellen löschen (Kunde und Komm)
Set QDelete = db1.OpenQueryDef("Kunde komplett löschen")
QDelete.Execute
QDelete.Close
Set QDelete = Nothing

'übergabeparameter zum Umkopieren sind Ziel und Herkunftstabelle

MoveTabelle "Kunde", "Kunde_Rest"
MoveTabelle "Komm", "Komm_Rest"


End Sub

Sub Delete_Kunde (lkDnr As Long)
'mit oder ohne ref.Integrität
'ohne Löschweitergabe

Dim QDelete As Querydef
Dim sql As String

'Zuerst Komm-Daten löschen
sql = "DELETE DISTINCTROW  Komm.KDNummer, * "
sql = sql & "FROM Komm "
sql = sql & "WHERE ((Komm.KDNummer=" & Str$(lkDnr) & "));"

Set QDelete = db1.CreateQueryDef("DelKomm", sql)
QDelete.Execute
QDelete.Close
'angelegte Query löschen
db1.DeleteQueryDef ("DelKomm")

sql = "DELETE DISTINCTROW Kunde.Nummer, * "
sql = sql & "FROM Kunde "
sql = sql & "WHERE ((Kunde.Nummer=" & Str$(lkDnr) & ")); "

Set QDelete = db1.CreateQueryDef("DelKunde", sql)
QDelete.Execute
QDelete.Close
'angelegte Query löschen
db1.DeleteQueryDef ("DelKunde")

End Sub

Sub Delete_Kunde_2 (lkDnr As Long)
'mit ref.Integrität
'mit Löschweitergabe

Dim QDelete As Querydef
Dim sql As String

sql = "DELETE DISTINCTROW Kunde.Nummer, * "
sql = sql & "FROM Kunde "
sql = sql & "WHERE ((Kunde.Nummer=" & Str$(lkDnr) & ")); "

Set QDelete = db1.CreateQueryDef("DelKunde_und_Komm", sql)
QDelete.Execute
QDelete.Close

'angelegte Query löschen
db1.DeleteQueryDef ("DelKunde_und_Komm")

End Sub

Sub Delete_Kunde_3 (lkDnr As Long)

'mit ref.Integrität
'mit Löschweitergabe

Dim QDelete As Querydef

Set QDelete = db1.OpenQueryDef("DelKundeP")
QDelete!lkDnr = lkDnr

QDelete.Execute
QDelete.Close

End Sub

Sub Form_Load ()

CenterForm Me
data1.DatabaseName = sMdb
Data2.DatabaseName = sMdb

End Sub

Function MdbCheck () As Integer

Dim it As Integer
Dim lmdb As Long
Dim sMsg As String
Dim iDgDef As Integer
Dim iResponse As Integer
Dim sTitel As String

Set tSettings = db1.OpenTable("Settings")
If tSettings!MdbVersion <> iVersion Then
 tSettings.Close
 MdbCheck = True
 Exit Function
End If

If DaysBetweenDates&((tSettings!LastReorg), Datum) > 14 Then

 sTitel = "Verdichtung"
 sMsg = "Datenbank ist seit mehr als 14 Tagen nicht mehr komprimiert worden." + NL
 sMsg = sMsg + "Wollen Sie jetzt verdichten ?" + NL
 iDgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2
 iResponse = MsgBox(sMsg, iDgDef, sTitel)

 If iResponse = IDYES Then
  tSettings.Close
  If mdbVerdichten() Then
   Set tSettings = db1.OpenTable("Settings")
   tSettings.Edit
   tSettings!LastReorg = Datum
   tSettings.Update
  End If
 End If
End If
tSettings.Close
End Function

Sub mnuAboutInfo_Click ()

End Sub

Sub mnuEnd_Click ()
Unload Me
End Sub

Sub MoveTabelle (sZiel As String, sHerkunft As String)
Dim tZiel As Table
Dim tHerkunft As Table
Dim iCount As Integer

Set tZiel = db1.OpenTable(sZiel)
Set tHerkunft = db1.OpenTable(sHerkunft)

tHerkunft.MoveFirst
BeginTrans

Do While tHerkunft.EOF = False
  tZiel.AddNew
  For iCount = 0 To tHerkunft.Fields.Count - 1
    tZiel.Fields(iCount) = tHerkunft.Fields(iCount)
  Next
  tZiel.Update
  tHerkunft.MoveNext
Loop
CommitTrans
tZiel.Close
Set tZiel = Nothing
tHerkunft.Close
Set tHerkunft = Nothing

End Sub

Sub Text1_Change ()
Dim sql As String
Dim sPartner As String
Dim sTelefon As String

'Aufbau einer SQL-Abfrage mit Einbindung der Kunden-Nummer
sql = "SELECT DISTINCTROW Komm.Telefon, Komm.Partner "
sql = sql & "FROM Kunde INNER JOIN Komm ON Kunde.Nummer = "
sql = sql & "Komm.KDNummer "
sql = sql & "WHERE ((Komm.KDNummer=" & Text1.Text & ")); "

'Zuweisung
Data2.RecordSource = sql
Data2.Refresh
List1.Clear
'wenn kein Eintrag, Abbruch
If Data2.Recordset.BOF Then Exit Sub

'Durchlaufe das Dynaset und fülle das Dynaset
Do While Data2.Recordset.EOF = False
 sPartner = Data2.Recordset!Partner & ""
 sTelefon = Data2.Recordset!Telefon & ""
 List1.AddItem sPartner + Chr$(9) + sTelefon
 Data2.Recordset.MoveNext
Loop
End Sub