|
Autowert zuruecksetzen (auch bei Access 2000!)
|
| Autor |
Nachricht |
Willi Wipp
Moderator
Verfasst am:
01. Sep 2005, 15:24
Rufname:
Wohnort: Raum Wiesbaden
|
|
| |
|
Hi Folks,
hier eine Loesung fuer das bekannte Problem unter Access 2000
| Code: | Public Function FnSetzeAutowertZurueck(sFeld As String, sTable As String)
Dim lNeu As Long
lNeu& = Nz(DMax(sFeld$, sTable$), 0) + 1
CurrentDb.Execute "ALTER TABLE " & sTable & _
" ALTER COLUMN " & sFeld$ & " COUNTER(" & lNeu& & ",1)"
End Function
'Zum Testen im Direktfenster (Strg+G; Testfenster)
'FnSetzeAutowertZurueck "[DeinAutowertFeld]", "[DeineTabelle]" |
Basiert auf dem Beitrag Autowert zurücksetzen ? von Jens05
ACHTUNG: Wenn man den Autowert auf einen Wert zuruecksetzt der kleiner ist als der
groesste aktuelle Wert im Feld, dann wird das zu unweigerlich zu Problemen fuehren!
D.h. es wir der gleiche Autowert mehrfach vergeben!
_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp
(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)
Zuletzt bearbeitet von Willi Wipp am 17. Jul 2011, 07:12, insgesamt 4-mal bearbeitet |
|
Gast
Verfasst am:
13. Sep 2005, 23:42
Rufname:
|
| |
| |
|
Hallo, als Access-Neuling war mir die Code-Lösung zu schwer.
Diese Lösung vom microsoft support hat mir sehr geholfen:
| Zitat: | Methode 1
Sie können einen AutoWert-Feldwert so zurücksetzen, dass er mit einem der Felder in der Tabelle übereinstimmt. Gehen Sie hierzu folgendermaßen vor:
1. Löschen Sie das AutoWert-Feld aus der Haupttabelle.
Notieren Sie den Namen des AutoWert-Feldes.
2. Klicken Sie im linken Fenster auf Abfragen. Doppelklicken Sie im rechten Fenster auf Erstellt eine neue Abfrage in der Entwurfsansicht.
3. Wählen Sie im Dialogfeld Tabelle anzeigen die Haupttabelle aus. Klicken Sie auf Hinzufügen, und klicken Sie anschließend auf Schließen.
4. Doppelklicken Sie in der Tabellenansicht der Haupttabelle auf die erforderlichen Felder, um sie auszuwählen.
5. Wählen Sie die Sortierreihenfolge aus.
6. Klicken Sie im Menü Abfrage auf Tabellenerstellungsabfrage. Geben Sie den neuen Tabellennamen im Textfeld Tabellenname ein, und klicken Sie auf OK.
7. Klicken Sie im Menü Abfrage auf Ausführen.
8. Es wird ein Dialogfeld mit folgendem Text angezeigt: Sie beabsichtigen, # Zeile(n) in eine neue Tabelle einzufügen. Klicken Sie auf Ja, um die Zeilen einzufügen.
9. Klicken Sie im Menü Datei auf Schließen. Klicken Sie auf Nein, um das Fenster Tabellenerstellungsabfrage zu schließen.
10. Klicken Sie im linken Fenster auf Tabellen. Klicken Sie mit der rechten Maustaste auf die neue Tabelle, und klicken Sie anschließend auf Entwurfsansicht.
11. Fügen Sie in der Ansicht Entwurf der Tabelle ein AutoWert-Feld mit dem Feldnamen hinzu, den Sie in Schritt 1 gelöscht haben. Fügen Sie dieses AutoWert-Feld zur neuen Tabelle hinzu, und speichern Sie die Tabelle.
12. Schließen Sie die Ansicht Entwurf.
13. Benennen Sie die Haupttabelle um. Geben Sie der neuen Tabelle den Namen der Haupttabelle. |
|
|
Willi Wipp
Moderator
Verfasst am:
14. Sep 2005, 11:57
Rufname:
Wohnort: Raum Wiesbaden
|
|
| |
|
Hi Gast,
das ist auch eine Moeglichkeit, wobei sich fragt was wirklich einfacher ist 
Die Methode hat einen weiteren Nachteil:
Wenn Beziehungen gesetzt sind, dann muss man diese loeschen und wieder setzen.
Das kann zu massiven Problemen fuehren
Nachfragen zum Thema bitte hier Autowert zuruecksetzen {Nachgefragt} stellen.
_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp
(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)
|
|
Dalmatinchen
look into my eyes ...
Verfasst am:
11. Apr 2006, 09:17
Rufname:
Wohnort: Steiermark/Österreich
|
|
| |
|
Hallo!
Ein sehr schönes Beispiel, das Jens hier gebastelt hat.
Man kann den Code auch etwas abändern, damit man den Autowert mit einem höheren Startwert beginnen lassen kann:
| Code: | Public Function FnSetzeAutowertZurueck(sFeld As String, sTable As String)
Dim lNeu As Long
lNeu& = Nz(DMax(sFeld$, sTable$), 0) + 1050 '<===
CurrentDb.Execute "ALTER TABLE " & sTable & _
" ALTER COLUMN " & sFeld$ & " COUNTER(" & lNeu& & ",1)"
End Function
'Zum Testen im Direktfenster (Strg+G; Testfenster)
'FnSetzeAutowertZurueck "[DeinAutowertFeld]", "[DeineTabelle]" |
In diesem Fall würde der Autowert nicht bei 1 sondern bei 1050 starten.
LG Dalmatinchen
_________________
FEEDBACK nützt jedem!
+++ Auf meiner Homepage findet Ihr zahlreiche Access-Beispiele als Download mit Erklärung! +++
|
|
Willi Wipp
Moderator
Verfasst am:
12. Apr 2006, 15:50
Rufname:
Wohnort: Raum Wiesbaden
|
| |
| |
|
Hi Dalmatinchen,
oder noch etwas flexiebler | Code: | Public Function FnSetzeAutowertZurueck(sFeld As String, sTable As String, _
Optional lStart As Long = 1, _
Optional lStep As Long = 1)
Dim lNeu As Long
lNeu& = Nz(DMax(sFeld$, sTable$), 0) + lStart& '<===
CurrentDb.Execute "ALTER TABLE " & sTable & _
" ALTER COLUMN " & sFeld$ & _
" COUNTER(" & lNeu& & "," & lStep& & ")"
End Function
'Zum Testen im Direktfenster (Strg+G; Testfenster)
'FnSetzeAutowertZurueck "[DeinAutowertFeld]", "[DeineTabelle]", 1050
'FnSetzeAutowertZurueck "[DeinAutowertFeld]", "[DeineTabelle]", 1050, 100 |
[edit]Den optionalen Parameter lStep hinzugefuegt. Definiert die Schrittweite (Increment).[/edit]
_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp
(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)
Zuletzt bearbeitet von Willi Wipp am 12. Okt 2006, 14:23, insgesamt 3-mal bearbeitet |
|
Gschaftlhuaba
Gast
Verfasst am:
12. Apr 2006, 21:33
Rufname:
|
|
| |
|
Hallo,
für mich stellt sich die Frage, wann man überhaupt einen Autwert zurücksetzen will. Doch nur dann, wenn man sämtliche Datensätze aus einer Tabelle entfernt hat und dann wieder bei "1" beginnen will.
Ich mach das zurücksetzen ganz einfach. Ich lösche sämtliche Datensätze einer Tabelle, die einen Autowert hat. Dann wähle ich die Funktion "Komprimieren und Reparieren". Danach fängt der Autowert automatisch wieder bei 1 in der Tabelle an.
Ich weiß, dass das bei Access 2002 und 2003 funktioniert - vielleicht ja auch bei 2000.
|
|
Dalmatinchen
look into my eyes ...
Verfasst am:
12. Apr 2006, 21:37
Rufname:
Wohnort: Steiermark/Österreich
|
|
| |
|
Hallo!
Auch ne Möglichkeit ... bedenke aber, dass bei manchen Programmen, die dann fertiggestellt sind, kein Zugriff mehr auf's Standardmenü besteht.
LG Dalmatinchen
_________________
FEEDBACK nützt jedem!
+++ Auf meiner Homepage findet Ihr zahlreiche Access-Beispiele als Download mit Erklärung! +++
Zuletzt bearbeitet von Dalmatinchen am 24. Apr 2006, 13:25, insgesamt einmal bearbeitet |
|
Willi Wipp
Moderator
Verfasst am:
12. Apr 2006, 22:14
Rufname:
Wohnort: Raum Wiesbaden
|
|
| |
|
Hi Gschaftlhuaba,
der eigentlich Sinn der Funktion ist es ja das "Problem" bei Access 2000 zu umgehen,
das man bei weiterhin bestehenden DS in einer Tabelle den Autowert-Zaehler nicht wieder
durch Komprimieren "zurueckdrehen" kann.
Das kommt gerade beim Erstellen und Testen von DB's schon haeufiger vor.
Z.B. Tabellen mit Standard-DS die dann weiter gefuellte werden koennen.
_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp
(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)
|
|
jens05
Moderator
Verfasst am:
24. Apr 2007, 20:35
Rufname:
Wohnort: ~~~~~
|
|
Waggis
Gast
Verfasst am:
28. Sep 2011, 01:46
Rufname:
|
|
| Version: Office 2010 |
|
Funktioniert auch im Access 2010
Danke Dalmatine
| Code: | Public Function FnSetzeAutowertZurueck(sFeld As String, sTable As String)
Dim lNeu As Long
lNeu& = Nz(DMax(sFeld$, sTable$), 0) + 1050 '<===
CurrentDb.Execute "ALTER TABLE " & sTable & _
" ALTER COLUMN " & sFeld$ & " COUNTER(" & lNeu& & ",1)"
End Function
'Zum Testen im Direktfenster (Strg+G; Testfenster)
'FnSetzeAutowertZurueck "[DeinAutowertFeld]", "[DeineTabelle]" |
|
|
MaHumba
Office- und VBA-Kenner
Verfasst am:
31. Jan 2012, 12:43
Rufname:
|
|
| Version: Office 2010 |
|
Hallo zusammen,
nachdem ich mich nun auch mehrere Tage durch dieses Thema gequält habe, hier meine (erweiterten) Erkenntnisse dazu.
Einleitung:
Ich möchte, während ich entwickle, auf meinem Backend testen und es dem jeweils aktuellen Entwicklungsstand anpassen.
Zum Ausliefern der Anwendung brauche ich dann ein "sauberes" Backend.
Deshalb möchte ich die Spuren der Tests beseitigen also Daten löschen und Autowerte zurücksetzen.
Funktionsweise:- Im Prozeduraufruf wird der Name einer Tabelle und ggf. zwei weitere Parameter (s.u.) übergeben.
- Die Tabelle soll geleert und ein Autowert-Feld (Primärindex) soll auf Startwert 1 zurückgesetzt werden.
- Das Autowert-Feld ist immer das erste Feld (Fields(0)) in jeder Tabelle
- In manchen Tabellen verwende ich Fixwerte die immer zur Verfügung stehen müssen, also auch nach den Tests nicht gelöscht werden dürfen.
Diese müssen als erste Datensätze und lückenlos in der Tabelle stehen
und werden über den zweiten Parameter (rDeleteFrom) vom Löschen ausgeschlossen
(Standard ist, dass alle Datensätze gelöscht werden).
- Im dritten Parameter kann man festlegen, in welcher Schrittweite das Autowertfeld zählen soll
(Habe ich bisher noch nie gebraucht)
- Damit das Autowert-Feld zurückgesetzt werden kann, darf es nicht Bestandteil von Beziehungen sein.
Also lösche ich bestehende Beziehungen und richte sie nach dem Tabellen-Reset wieder ein.
- Ich verwende zwei Methoden zum Löschen und Wiederherstellen der Beziehungen um auch den (teilweise heftig umstrittenen) Mehrfachwertfeldern gerecht zu werden
(Die lassen sich nicht mit "ALTER TABLE ..." verwalten)
Nun muss ich nur noch die Prozedur in der richtigen Reihenfolge für jede Tabelle - unter Berücksichtigung von Abhängigkeiten - aufrufen, anschließend das BE komprimieren und es ist wieder "jungfräulich".
| Code: | Public Sub dbReset_Table(rTabName As String, _
Optional rDeleteFrom As Long = 1, _
Optional rAutoStep As Long = 1)
' ******************************************************************************
' *** Tabelle zurücksetzen (Inhalt löschen und Autowert zurücksetzen)
' ******************************************************************************
On Error GoTo Fehler
' *** Namen und Bezeichner
Dim rIDFieldName As String
Dim rConnectionString As String
Dim rDBName As String
Dim rAttributes As String
' *** ADO-Objekte
Dim rADOCommand As ADODB.Command
Dim rADOConnection As ADODB.Connection
' *** DAO-Objekte
Dim rDataBase As Database
Dim rRecSetRelations As Recordset
Dim rRelationOld As Relation
Dim rRelation() As Relation
Dim rRelationNum As Integer
' **************************************************************
' ******* Heimat-DB der Tabelle ermitteln
' *** Connection-String der Tabelle (leer oder ';DATABASE=...')
rConnectionString = CurrentDb.TableDefs(rTabName).Connect
rIDFieldName = CurrentDb.TableDefs(rTabName).Fields(0).Name
If rConnectionString = "" Then
' ***** Lokale Tabelle
rDBName = CurrentDb.Name
' *** DAO
Set rDataBase = CurrentDb
Else
' ***** Verknüpfte Tabelle
' *** Datenbank-Name
rDBName = Right(rConnectionString, _
Len(rConnectionString) _
- InStr(1, rConnectionString, "DATABASE=") _
- Len("DATABASE"))
' *** DAO
Set rDataBase = OpenDatabase(rDBName, False, False, _
";PWD=" & passwort)
End If
' **************************************************************
' ***** ADO vorbereiten
' *** ADO-Connection öffnen
Set rADOConnection = New ADODB.Connection
rADOConnection.Provider = "Microsoft.ACE.OLEDB.12.0"
rADOConnection.Properties("Jet OLEDB:Database Password") _
= passwort
rADOConnection.Properties("Data Source") = rDBName
rADOConnection.Open
' *** ADO-Command vorbereiten
Set rADOCommand = New ADODB.Command
Set rADOCommand.ActiveConnection = rADOConnection
' **************************************************************
' ***** Beziehungen des Feldes der Tabelle ermitteln
' Geht nur mit DAO, bei ADO fehlen die Leserechte!!!
Set rRecSetRelations = rDataBase.OpenRecordset("SELECT * " _
& "FROM MSysRelationships " _
& "WHERE szReferencedObject = '" & rTabName & "'" _
& " AND szReferencedColumn = '" & rIDFieldName & "'", _
dbOpenSnapshot)
If rRecSetRelations.RecordCount > 0 Then
' ***************************************************
' ******* Es gibt Beziehungen zu dieser Tabelle
' **********************************************
' ***** Beziehungen löschen
' *** Erste Beziehung
rRelationNum = 0
rRecSetRelations.MoveFirst
While Not rRecSetRelations.EOF
' *** Aktuelle Beziehung löschen
If rRecSetRelations!szColumn = "Value" Then
' ***********************************************
' ***** Mehrfachwertfeld:
' kann nicht mit ALTER TABLE gelöscht werden
Set rRelationOld = _
rDataBase.Relations(rRecSetRelations!szRelationship)
ReDim Preserve rRelation(0 To rRelationNum)
Set rRelation(rRelationNum) = New Relation
rRelation(rRelationNum).Name = rRelationOld.Name
rRelation(rRelationNum).Attributes = rRelationOld.Attributes
rRelation(rRelationNum).Table = rRelationOld.Table
rRelation(rRelationNum).ForeignTable = rRelationOld.ForeignTable
rRelation(rRelationNum).Fields.Append _
rRelation(rRelationNum).CreateField( _
rRelationOld.Fields(0).Name)
rRelation(rRelationNum).Fields(0).ForeignName = _
rRelationOld.Fields(0).ForeignName
' *** Beziehung löschen
rDataBase.Relations.Delete rRelationOld.Name
Set rRelationOld = Nothing
rDataBase.Relations.Refresh
Else
' ***********************************************
' ***** Sonstiges Feld
rADOCommand.CommandText = _
"ALTER TABLE " & rRecSetRelations!szObject _
& " DROP CONSTRAINT " & rRecSetRelations!szRelationship
rADOCommand.Execute
End If
' *** Nächste Beziehung
rRelationNum = rRelationNum + 1
rRecSetRelations.MoveNext
Wend
End If
' **************************************************************
' ***** Tabelle zurücksetzen
' *** Tabelleminhalte löschen
rADOCommand.CommandText = "DELETE FROM " & rTabName _
& " WHERE " & rIDFieldName & " >= " & rDeleteFrom
rADOCommand.Execute
' *** Autowert zurücksetzen
rADOCommand.CommandText = "ALTER TABLE " & rTabName _
& " ALTER COLUMN " & rIDFieldName _
& " COUNTER(" & rDeleteFrom & ", " & rAutoStep & ")"
rADOCommand.Execute
If rRecSetRelations.RecordCount > 0 Then
' ***************************************************
' ******* Es gab Beziehungen zu dieser Tabelle
' **********************************************
' ***** Beziehungen wieder herstellen
' *** Erste Beziehung
rRelationNum = 0
rRecSetRelations.MoveFirst
While Not rRecSetRelations.EOF
If rRecSetRelations!szColumn = "Value" Then
' ***********************************************
' ***** Mehrfachwertfeld:
' kann nicht mit ALTER TABLE angefügt werden
rDataBase.Relations.Append rRelation(rRelationNum)
rDataBase.Relations.Refresh
Set rRelation(rRelationNum) = Nothing
Else
' ***********************************************
' ***** Sonstiges Feld
' ***************************************
' *** Eigenschaften (Attribute) der aktuellen Beziehung
' Hierfür muss ADO verwendet werden!!!
rAttributes = ""
If (rRecSetRelations!grbit And dbRelationUpdateCascade) _
= dbRelationUpdateCascade Then
' *** Aktualisierungsweitergabe
rAttributes = " ON UPDATE CASCADE"
End If
If (rRecSetRelations!grbit And dbRelationDeleteCascade) _
= dbRelationDeleteCascade Then
' *** Löschweitergabe
rAttributes = rAttributes & " ON DELETE CASCADE"
End If
' ***************************************
' *** Aktuelle Beziehung erstellen
rADOCommand.CommandText = _
"ALTER TABLE " & rRecSetRelations!szObject _
& " ADD CONSTRAINT " & rRecSetRelations!szRelationship _
& " FOREIGN KEY (" & rRecSetRelations!szColumn & ")" _
& " REFERENCES " & rRecSetRelations!szReferencedObject _
& " (" & rRecSetRelations!szReferencedColumn & ")" _
& rAttributes
rADOCommand.Execute
End If
' *** Nächste Beziehung
rRelationNum = rRelationNum + 1
rRecSetRelations.MoveNext
Wend
End If
GoTo Ausgang
Fehler:
MsgBox Err.Description, vbCritical, _
"modDataBase-dbReset_Table-Error: " & Err.Number
Ausgang:
' *** ADO
Set rADOCommand = Nothing
Set rADOConnection = Nothing
' *** DAO
Set rRecSetRelations = Nothing
Set rDataBase = Nothing
End Sub |
Und als Kurzversion, weil die meisten ohnehin nicht mit Mehrfachwertfeldern arbeiten
| Code: | Public Sub dbReset_Table_Short(rTabName As String, _
Optional rDeleteFrom As Long = 1, _
Optional rAutoStep As Long = 1)
' ******************************************************************************
' *** Tabelle zurücksetzen (Inhalt löschen und Autowert zurücksetzen)
' ******************************************************************************
On Error GoTo Fehler
' *** Namen und Bezeichner
Dim rIDFieldName As String
Dim rConnectionString As String
Dim rDBName As String
Dim rAttributes As String
' *** ADO-Objekte
Dim rADOCommand As ADODB.Command
Dim rADOConnection As ADODB.Connection
' *** DAO-Objekte
Dim rDataBase As Database
Dim rRecSetRelations As Recordset
' **************************************************************
' ******* Heimat-DB der Tabelle ermitteln
' *** Connection-String der Tabelle (leer oder ';DATABASE=...')
rConnectionString = CurrentDb.TableDefs(rTabName).Connect
rIDFieldName = CurrentDb.TableDefs(rTabName).Fields(0).Name
If rConnectionString = "" Then
' ***** Lokale Tabelle
rDBName = CurrentDb.Name
' *** DAO
Set rDataBase = CurrentDb
Else
' ***** Verknüpfte Tabelle
' *** Datenbank-Name
rDBName = Right(rConnectionString, _
Len(rConnectionString) _
- InStr(1, rConnectionString, "DATABASE=") _
- Len("DATABASE"))
' *** DAO
Set rDataBase = OpenDatabase(rDBName, False, False, _
";PWD=" & passwort)
End If
' **************************************************************
' ***** ADO vorbereiten
' *** ADO-Connection öffnen
Set rADOConnection = New ADODB.Connection
rADOConnection.Provider = "Microsoft.ACE.OLEDB.12.0"
rADOConnection.Properties("Jet OLEDB:Database Password") _
= passwort
rADOConnection.Properties("Data Source") = rDBName
rADOConnection.Open
' *** ADO-Command vorbereiten
Set rADOCommand = New ADODB.Command
Set rADOCommand.ActiveConnection = rADOConnection
' **************************************************************
' ***** Beziehungen des Feldes der Tabelle ermitteln
' Geht nur mit DAO, bei ADO fehlen die Leserechte!!!
Set rRecSetRelations = rDataBase.OpenRecordset("SELECT * " _
& "FROM MSysRelationships " _
& "WHERE szReferencedObject = '" & rTabName & "'" _
& " AND szReferencedColumn = '" & rIDFieldName & "'", _
dbOpenSnapshot)
If rRecSetRelations.RecordCount > 0 Then
' ***************************************************
' ******* Es gibt Beziehungen zu dieser Tabelle
' **********************************************
' ***** Beziehungen löschen
' *** Erste Beziehung
rRecSetRelations.MoveFirst
While Not rRecSetRelations.EOF
' *** Aktuelle Beziehung löschen
rADOCommand.CommandText = _
"ALTER TABLE " & rRecSetRelations!szObject _
& " DROP CONSTRAINT " & rRecSetRelations!szRelationship
rADOCommand.Execute
' *** Nächste Beziehung
rRecSetRelations.MoveNext
Wend
End If
' **************************************************************
' ***** Tabelle zurücksetzen
' *** Tabelleminhalte löschen
rADOCommand.CommandText = "DELETE FROM " & rTabName _
& " WHERE " & rIDFieldName & " >= " & rDeleteFrom
rADOCommand.Execute
' *** Autowert zurücksetzen
rADOCommand.CommandText = "ALTER TABLE " & rTabName _
& " ALTER COLUMN " & rIDFieldName _
& " COUNTER(" & rDeleteFrom & ", " & rAutoStep & ")"
rADOCommand.Execute
If rRecSetRelations.RecordCount > 0 Then
' ***************************************************
' ******* Es gab Beziehungen zu dieser Tabelle
' **********************************************
' ***** Beziehungen wieder herstellen
' *** Erste Beziehung
rRecSetRelations.MoveFirst
While Not rRecSetRelations.EOF
' *** Eigenschaften (Attribute) der aktuellen Beziehung
' Hierfür muss ADO verwendet werden!!!
rAttributes = ""
If (rRecSetRelations!grbit And dbRelationUpdateCascade) _
= dbRelationUpdateCascade Then
' *** Aktualisierungsweitergabe
rAttributes = " ON UPDATE CASCADE"
End If
If (rRecSetRelations!grbit And dbRelationDeleteCascade) _
= dbRelationDeleteCascade Then
' *** Löschweitergabe
rAttributes = rAttributes & " ON DELETE CASCADE"
End If
' ***************************************
' *** Aktuelle Beziehung erstellen
rADOCommand.CommandText = _
"ALTER TABLE " & rRecSetRelations!szObject _
& " ADD CONSTRAINT " & rRecSetRelations!szRelationship _
& " FOREIGN KEY (" & rRecSetRelations!szColumn & ")" _
& " REFERENCES " & rRecSetRelations!szReferencedObject _
& " (" & rRecSetRelations!szReferencedColumn & ")" _
& rAttributes
rADOCommand.Execute
' *** Nächste Beziehung
rRecSetRelations.MoveNext
Wend
End If
GoTo Ausgang
Fehler:
MsgBox Err.Description, vbCritical, _
"modDataBase-dbReset_Table_Short-Error: " & Err.Number
Ausgang:
' *** ADO
Set rADOCommand = Nothing
Set rADOConnection = Nothing
' *** DAO
Set rRecSetRelations = Nothing
Set rDataBase = Nothing
End Sub |
Ohne Gewähr und Anspruch auf Vollständigkeit!
Dennoch, vielleicht hilft es dem einen oder der anderen auch...
|
|
Horoman.
Gast
Verfasst am:
22. Feb 2012, 20:22
Rufname:
|
| |
| Version: Office 2007 |
|
Besten Dank an MaHumba
Als ich auf Deinen Beitrag gestossen bin, hatte ich den Inhalt der Tabellen bereits gelöscht.
| Code: | Private Sub DeleteContent()
DoCmd.RunSQL "DELETE * FROM Buchungen"
End Sub |
Dann habe ich den Code einfach per Copy Paste eingefügt. Da hat dann der Compiler reklamiert, dass passwort nicht definiert ist. Nun das ist halb so wild. Kann man ja einfügen. Meine Datenbank ist sowieso lokal und braucht all das Zeugs nicht. Deshalb habe ich Deinen Code auf meine Bedürfniss gekürzt.
Bemerkung: Bei mir funktioniert es auch ohne ADO... dazu ist zu aber zu erwähnen, dass ich jeweils keine Attribute hatte.
| Code: | Private Sub ResetCounter()
Dim rsRelations As DAO.Recordset
Dim rDataBase As DAO.Database
Dim sTabName As String
Dim sIDFieldName As String
Dim sAttributes As String
sTabName = "Buchungen"
sIDFieldName = "ID"
Set rDataBase = CurrentDb
' Beziehungen des Feldes der Tabelle ermitteln
Set rsRelations = rDataBase.OpenRecordset("SELECT * " _
& " FROM MSysRelationships" _
& " WHERE szReferencedObject = '" & sTabName & "'" _
& " AND szReferencedColumn = '" & sIDFieldName & "'" _
, dbOpenSnapshot)
If Not (rsRelations.BOF And rsRelations.EOF) Then
'Es gibt Beziehungen zu dieser Tabelle
'Beziehungen müssen gelöscht werden, damit der Autowert zurückgesetzt werden kann:
rsRelations.MoveFirst
While Not rsRelations.EOF
'Aktuelle Beziehung löschen
rDataBase.Execute ("ALTER TABLE " & rsRelations!szObject _
& " DROP CONSTRAINT " & rsRelations!szRelationship)
'Nächste Beziehung
rsRelations.MoveNext
Wend
End If
'Autowert zurücksetzen
CurrentDb.Execute "ALTER TABLE [" & sTabName & "]" _
& " ALTER COLUMN [" & sIDFieldName & "] COUNTER(1,1)"
'Beziehungen wiederherstellen
If rsRelations.RecordCount > 0 Then
' Es gab Beziehungen zu dieser Tabelle
' Erste Beziehung
rsRelations.MoveFirst
While Not rsRelations.EOF
' *** Eigenschaften (Attribute) der aktuellen Beziehung
' Hierfür muss ADO verwendet werden!!!
sAttributes = ""
If (rsRelations!grbit And dbRelationUpdateCascade) _
= dbRelationUpdateCascade Then
' *** Aktualisierungsweitergabe
sAttributes = " ON UPDATE CASCADE"
End If
If (rsRelations!grbit And dbRelationDeleteCascade) _
= dbRelationDeleteCascade Then
' *** Löschweitergabe
sAttributes = sAttributes & " ON DELETE CASCADE"
End If
' Aktuelle Beziehung erstellen
rDataBase.Execute "ALTER TABLE [" & rsRelations!szObject & "]" _
& " ADD CONSTRAINT " & rsRelations!szRelationship _
& " FOREIGN KEY ([" & rsRelations!szColumn & "])" _
& " REFERENCES [" & rsRelations!szReferencedObject & "]" _
& " ([" & rsRelations!szReferencedColumn & "])" _
& sAttributes
' Nächste Beziehung
rsRelations.MoveNext
Wend
End If
Set rsRelations = Nothing
Set rDataBase = Nothing
End Sub |
Nachtrag:
Zu erwähnen wäre noch, dass bei mir der ADD CONSTRAINS Probleme machte. Grund dafür ist, dass ich in meiner kleine lokalen Datenbank Leerschläge in den Feldnamen hatte. Keine Leerschläge sind natürlich grundsätzlich besser. Trotzdem ist das Problem lösbar und zwar mit den eingefügten eckigen Klammern [] (siehe Code von oben).
|
|
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen
|
|
|
|
| Verwandte Themen |
| Forum / Themen |
Antworten |
Autor |
Aufrufe |
Letzter Beitrag |
 |
Access Tabellen & Abfragen: Feld mit AutoWert sinnvoll? |
1 |
Schneehasal18 |
707 |
21. März 2006, 10:09
stpimi  |
 |
Access Tabellen & Abfragen: Problem mit Access 2000 |
1 |
Gast |
492 |
14. Jan 2006, 23:49
Helge |
|
Access Tabellen & Abfragen: Autowert in eine Tabelle übertragen... |
4 |
Mr.E |
1603 |
27. Okt 2005, 08:53
Mr.E |
|
Access Tabellen & Abfragen: Aufträge nach Monaten abfragen - Access 2000 |
2 |
langnet |
896 |
23. Okt 2005, 22:50
langnet |
|
Access Tabellen & Abfragen: Problem:Fragmentierte Index-Vergabe (Access 2000) |
6 |
waldwuffel |
902 |
08. Sep 2005, 18:30
waldwuffel |
|
Access Tabellen & Abfragen: ind.CreateField: Zuweisung Felddatentyp "AutoWert" |
3 |
RoWi |
4450 |
30. Jun 2005, 15:16
RoWi |
|
Access Tabellen & Abfragen: Abfrage wichtig Access 2000 |
1 |
sami? |
579 |
03. Mai 2005, 14:08
Dalmatinchen |
|
Access Tabellen & Abfragen: Position eines Leerzeichen von rechts suchen - Access 2000 |
3 |
ClayPigeons |
2107 |
11. Jan 2005, 12:53
Skogafoss |
|
Access Tabellen & Abfragen: Access 97 - 2000 'Analysieren mit MS Excel' Problem |
0 |
Visio |
1084 |
28. Dez 2004, 09:03
Visio |
|
Access Tabellen & Abfragen: Tabelle per SQL umbennen (Access 2000) |
2 |
DerPater |
1084 |
09. Dez 2004, 14:02
Gast |
|
Access Tabellen & Abfragen: Autowert für Auftrag und Auftragsposition (abhängig!) |
4 |
astrosoft |
1613 |
08. Dez 2004, 16:53
Skogafoss |
|
Access Tabellen & Abfragen: Undefinierte Abfrage - Access 2000 |
4 |
ClayPigeons |
794 |
18. Nov 2004, 18:00
ClayPigeons |
| |
|
