home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_6_93 / vbwin / vbaccess / kunde.txt < prev    next >
Text File  |  1995-02-26  |  5KB  |  214 lines
  1. Option Explicit
  2.  
  3. Const CMD_NORMAL = 0
  4. Const CMD_REF = 1
  5. Const CMD_PARAM = 2
  6. Const CMD_REST = 3
  7.  
  8. Sub cmdAktion_Click (Index As Integer)
  9. 'alle Command-Buttons sind als Array aufgebaut
  10. Select Case Index
  11. Case CMD_NORMAL
  12.   Delete_Kunde (Val(Text1))
  13. Case CMD_REF
  14.   Delete_Kunde_2 (Val(Text1))
  15. Case CMD_PARAM
  16.   Delete_Kunde_3 (Val(Text1))
  17. Case CMD_REST
  18.   Copy_Tabelle
  19. End Select
  20. 'Daten haben sich geΣndert
  21. data1.Refresh
  22. End Sub
  23.  
  24. Sub Copy_Tabelle ()
  25.  
  26. Dim QDelete As Querydef
  27. 'wiederherstellen der Tabellen in den Originalzustand
  28. 'dazu zuerst Original-Tabellen l÷schen (Kunde und Komm)
  29. Set QDelete = db1.OpenQueryDef("Kunde komplett l÷schen")
  30. QDelete.Execute
  31. QDelete.Close
  32. Set QDelete = Nothing
  33.  
  34. 'ⁿbergabeparameter zum Umkopieren sind Ziel und Herkunftstabelle
  35.  
  36. MoveTabelle "Kunde", "Kunde_Rest"
  37. MoveTabelle "Komm", "Komm_Rest"
  38.  
  39.  
  40. End Sub
  41.  
  42. Sub Delete_Kunde (lkDnr As Long)
  43. 'mit oder ohne ref.IntegritΣt
  44. 'ohne L÷schweitergabe
  45.  
  46. Dim QDelete As Querydef
  47. Dim sql As String
  48.  
  49. 'Zuerst Komm-Daten l÷schen
  50. sql = "DELETE DISTINCTROW  Komm.KDNummer, * "
  51. sql = sql & "FROM Komm "
  52. sql = sql & "WHERE ((Komm.KDNummer=" & Str$(lkDnr) & "));"
  53.  
  54. Set QDelete = db1.CreateQueryDef("DelKomm", sql)
  55. QDelete.Execute
  56. QDelete.Close
  57. 'angelegte Query l÷schen
  58. db1.DeleteQueryDef ("DelKomm")
  59.  
  60. sql = "DELETE DISTINCTROW Kunde.Nummer, * "
  61. sql = sql & "FROM Kunde "
  62. sql = sql & "WHERE ((Kunde.Nummer=" & Str$(lkDnr) & ")); "
  63.  
  64. Set QDelete = db1.CreateQueryDef("DelKunde", sql)
  65. QDelete.Execute
  66. QDelete.Close
  67. 'angelegte Query l÷schen
  68. db1.DeleteQueryDef ("DelKunde")
  69.  
  70. End Sub
  71.  
  72. Sub Delete_Kunde_2 (lkDnr As Long)
  73. 'mit ref.IntegritΣt
  74. 'mit L÷schweitergabe
  75.  
  76. Dim QDelete As Querydef
  77. Dim sql As String
  78.  
  79. sql = "DELETE DISTINCTROW Kunde.Nummer, * "
  80. sql = sql & "FROM Kunde "
  81. sql = sql & "WHERE ((Kunde.Nummer=" & Str$(lkDnr) & ")); "
  82.  
  83. Set QDelete = db1.CreateQueryDef("DelKunde_und_Komm", sql)
  84. QDelete.Execute
  85. QDelete.Close
  86.  
  87. 'angelegte Query l÷schen
  88. db1.DeleteQueryDef ("DelKunde_und_Komm")
  89.  
  90. End Sub
  91.  
  92. Sub Delete_Kunde_3 (lkDnr As Long)
  93.  
  94. 'mit ref.IntegritΣt
  95. 'mit L÷schweitergabe
  96.  
  97. Dim QDelete As Querydef
  98.  
  99. Set QDelete = db1.OpenQueryDef("DelKundeP")
  100. QDelete!lkDnr = lkDnr
  101.  
  102. QDelete.Execute
  103. QDelete.Close
  104.  
  105. End Sub
  106.  
  107. Sub Form_Load ()
  108.  
  109. CenterForm Me
  110. data1.DatabaseName = sMdb
  111. Data2.DatabaseName = sMdb
  112.  
  113. End Sub
  114.  
  115. Function MdbCheck () As Integer
  116.  
  117. Dim it As Integer
  118. Dim lmdb As Long
  119. Dim sMsg As String
  120. Dim iDgDef As Integer
  121. Dim iResponse As Integer
  122. Dim sTitel As String
  123.  
  124. Set tSettings = db1.OpenTable("Settings")
  125. If tSettings!MdbVersion <> iVersion Then
  126.  tSettings.Close
  127.  MdbCheck = True
  128.  Exit Function
  129. End If
  130.  
  131. If DaysBetweenDates&((tSettings!LastReorg), Datum) > 14 Then
  132.  
  133.  sTitel = "Verdichtung"
  134.  sMsg = "Datenbank ist seit mehr als 14 Tagen nicht mehr komprimiert worden." + NL
  135.  sMsg = sMsg + "Wollen Sie jetzt verdichten ?" + NL
  136.  iDgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2
  137.  iResponse = MsgBox(sMsg, iDgDef, sTitel)
  138.  
  139.  If iResponse = IDYES Then
  140.   tSettings.Close
  141.   If mdbVerdichten() Then
  142.    Set tSettings = db1.OpenTable("Settings")
  143.    tSettings.Edit
  144.    tSettings!LastReorg = Datum
  145.    tSettings.Update
  146.   End If
  147.  End If
  148. End If
  149. tSettings.Close
  150. End Function
  151.  
  152. Sub mnuAboutInfo_Click ()
  153.  
  154. End Sub
  155.  
  156. Sub mnuEnd_Click ()
  157. Unload Me
  158. End Sub
  159.  
  160. Sub MoveTabelle (sZiel As String, sHerkunft As String)
  161. Dim tZiel As Table
  162. Dim tHerkunft As Table
  163. Dim iCount As Integer
  164.  
  165. Set tZiel = db1.OpenTable(sZiel)
  166. Set tHerkunft = db1.OpenTable(sHerkunft)
  167.  
  168. tHerkunft.MoveFirst
  169. BeginTrans
  170.  
  171. Do While tHerkunft.EOF = False
  172.   tZiel.AddNew
  173.   For iCount = 0 To tHerkunft.Fields.Count - 1
  174.     tZiel.Fields(iCount) = tHerkunft.Fields(iCount)
  175.   Next
  176.   tZiel.Update
  177.   tHerkunft.MoveNext
  178. Loop
  179. CommitTrans
  180. tZiel.Close
  181. Set tZiel = Nothing
  182. tHerkunft.Close
  183. Set tHerkunft = Nothing
  184.  
  185. End Sub
  186.  
  187. Sub Text1_Change ()
  188. Dim sql As String
  189. Dim sPartner As String
  190. Dim sTelefon As String
  191.  
  192. 'Aufbau einer SQL-Abfrage mit Einbindung der Kunden-Nummer
  193. sql = "SELECT DISTINCTROW Komm.Telefon, Komm.Partner "
  194. sql = sql & "FROM Kunde INNER JOIN Komm ON Kunde.Nummer = "
  195. sql = sql & "Komm.KDNummer "
  196. sql = sql & "WHERE ((Komm.KDNummer=" & Text1.Text & ")); "
  197.  
  198. 'Zuweisung
  199. Data2.RecordSource = sql
  200. Data2.Refresh
  201. List1.Clear
  202. 'wenn kein Eintrag, Abbruch
  203. If Data2.Recordset.BOF Then Exit Sub
  204.  
  205. 'Durchlaufe das Dynaset und fⁿlle das Dynaset
  206. Do While Data2.Recordset.EOF = False
  207.  sPartner = Data2.Recordset!Partner & ""
  208.  sTelefon = Data2.Recordset!Telefon & ""
  209.  List1.AddItem sPartner + Chr$(9) + sTelefon
  210.  Data2.Recordset.MoveNext
  211. Loop
  212. End Sub
  213.  
  214.