Posted By

qrist0ph on 05/16/08


Tagged

access


Versions (?)

Who likes this?

1 person have marked this snippet as a favorite

qrist0ph


Cascading Action Scripts


 / Published in: Visual Basic
 

Follows the referencial integrity and backups and deletes records from tables

  1. Sub CascadingActionEntry()
  2. CascadingAction "Stamm-Produkte", "Art-Nr", "1014"
  3. End Sub
  4.  
  5.  
  6. Sub CascadingAction(tabellenName As String, field As String, value As String)
  7.  
  8. ' für alle referenzierenden datensätze (objekte) rekursiv CascadingBackup
  9. ' durchführen
  10. Dim rel As Relation
  11. Dim rs As Recordset
  12. Dim sqlQuery As String
  13.  
  14. '+------Parent------------+ +----Child-------------------------+
  15. '| Table , Fields(0).Name | ----Relation------|ForeignTable,Fields(0).ForeignName|
  16. '+------------------------+ +----------------------------------+
  17.  
  18. 'durch alle Relationen loopen (etwas umständlich)
  19. For Each rel In CurrentDb.Relations
  20. 'falls Relation mit dieser Tabelle
  21. If (rel.table = tabellenName) Then
  22. ' Alle kind objekte des gegenwärtigen Datensatzes (Objekt) über diese Relation (Kante) suchen
  23. 'sqlQuery = "SELECT * FROM " & rel.ForeignTable & " WHERE " & rel.Fields(0).ForeignName & " = '" & value & "'"
  24. sqlQuery = getSelectString(rel.ForeignTable, rel.Fields(0).ForeignName, value)
  25. Set rs = CurrentDb.OpenRecordset(sqlQuery)
  26. Do While (Not rs.EOF)
  27. ' Für alle referenzierenden Objekte Aktion durchführen
  28. CascadingAction rel.ForeignTable, rel.Fields(0).ForeignName, rs(rel.Fields(0).Name)
  29. rs.MoveNext
  30. Loop
  31. End If
  32. Next
  33. 'jetzt die eigentliche Aktion durchführen
  34. 'DELETE FROM tabellenName WHERE field = value
  35. 'MsgBox (tabellenName & " : " & value)
  36. doBackup tabellenName, field, value
  37. End Sub
  38.  
  39.  
  40. Private Function getSelectString(table As String, field As String, value As String)
  41. Dim sqlQuery As String
  42. 'falls der FK vom DatenType Text ist
  43. If (CurrentDb.TableDefs(table).Fields(field).Type = dbText) Then
  44. sqlQuery = "SELECT * FROM [" & table & "] WHERE [" & field & "] = '" & value & "'"
  45.  
  46. Else
  47. sqlQuery = "SELECT * FROM [" & table & "] WHERE [" & field & "] = " & value
  48. End If
  49.  
  50. getSelectString = sqlQuery
  51. End Function
  52.  
  53.  
  54.  
  55. Sub doBackup(tabellenName As String, field As String, value As String)
  56.  
  57. 'falls Backup Tabelle nicht existiert
  58. If (Not tableExists(tabellenName & "_archiv")) Then
  59. 'kopie erstellen
  60. DoCmd.CopyObject , tabellenName & "_archiv", acTable, tabellenName
  61. CurrentDb.Execute ("DELETE FROM [" & tabellenName & "_archiv]")
  62. End If
  63.  
  64. Dim sqlInsert As String
  65. Dim sqlDelete As String
  66. Dim sqlFields1 As String
  67. Dim sqlFields2 As String
  68.  
  69. sqlFields1 = ""
  70. sqlFields2 = ""
  71. Dim i As Integer
  72. Debug.Print (CurrentDb.TableDefs(tabellenName).Fields(1).Name)
  73.  
  74. For i = 0 To CurrentDb.TableDefs(tabellenName).Fields.Count - 2
  75. 'For Each f In CurrentDb.TableDefs(tabellenName).Fields
  76. sqlFields1 = sqlFields1 & " [" & CurrentDb.TableDefs(tabellenName).Fields(i).Name & "], "
  77. sqlFields2 = sqlFields2 & "[" & tabellenName & "].[" & CurrentDb.TableDefs(tabellenName).Fields(i).Name & "], "
  78. Next i
  79. sqlFields1 = sqlFields1 & "[" & CurrentDb.TableDefs(tabellenName).Fields(CurrentDb.TableDefs(tabellenName).Fields.Count - 1).Name & "]"
  80. sqlFields2 = sqlFields2 & "[" & tabellenName & "].[" & CurrentDb.TableDefs(tabellenName).Fields(CurrentDb.TableDefs(tabellenName).Fields.Count - 1).Name & "]"
  81.  
  82. 'falls das Feld vom DatenType Text ist
  83. If (CurrentDb.TableDefs(tabellenName).Fields(field).Type = dbText) Then
  84. sqlInsert = "INSERT INTO [" & tabellenName & "_archiv] (" & sqlFields1 & ") SELECT " & sqlFields2 & " FROM [" & tabellenName & "] WHERE [" & tabellenName & "].[" & field & "]='" & value & "'"
  85. sqlDelete = "DELETE FROM [" & tabellenName & "] WHERE [" & tabellenName & "].[" & field & "] ='" & value & "'"
  86.  
  87. Else
  88. sqlInsert = "INSERT INTO [" & tabellenName & "_archiv] (" & sqlFields1 & ") SELECT " & sqlFields2 & " FROM [" & tabellenName & "] WHERE [" & tabellenName & "].[" & field & "]=" & value
  89. sqlDelete = "DELETE FROM [" & tabellenName & "] WHERE [" & tabellenName & "].[" & field & "] =" & value
  90.  
  91. End If
  92.  
  93. Debug.Print sqlDelete
  94.  
  95.  
  96. CurrentDb.Execute (sqlInsert)
  97. CurrentDb.Execute (sqlDelete)
  98. 'falls der FK vom DatenType Text ist
  99.  
  100.  
  101. End Sub
  102.  
  103.  
  104. Private Function tableExists(e As String) As Boolean
  105. Dim i
  106. Dim contains As Boolean
  107. contains = False
  108. For Each i In CurrentDb.TableDefs
  109. If i.Name = e Then
  110. contains = True
  111. End If
  112. Next
  113. tableExists = contains
  114. End Function

Report this snippet  

You need to login to post a comment.