Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Autowert zuruecksetzen (auch bei Access 2000!)
zurück: Verschiedene Filter, neu mit Listenfeld weiter: Eine generische Datenbank - was ist das? Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Feedback Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Willi Wipp
Moderator


Verfasst am:
01. Sep 2005, 15:24
Rufname:
Wohnort: Raum Wiesbaden

Autowert zuruecksetzen (auch bei Access 2000!) - Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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:


AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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

Re: Autowert zuruecksetzen (auch bei Access 2000!) - Re: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

Hi Gast,

das ist auch eine Moeglichkeit, wobei sich fragt was wirklich einfacher ist Wink
Die Methode hat einen weiteren Nachteil:
Wenn Beziehungen gesetzt sind, dann muss man diese loeschen und wieder setzen.
Das kann zu massiven Problemen fuehren Wink

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

AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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


Re: Autowert zuruecksetzen (auch bei Access 2000!) - Re: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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:

AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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

AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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

Re: Autowert zuruecksetzen (auch bei Access 2000!) - Re: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

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: ~~~~~

AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       

Hallo,
anbei die Ursache und weitere Möglichkeiten zur Rücksetzung
Alle Autowert-Daten in Feld wird nicht zurückgesetzt, nachdem Sie eine Access-Datenbank komprimieren

Org: AutoNumber field is not reset after you compact an Access database

_________________
mfg jens05 Wink
Waggis
Gast


Verfasst am:
28. Sep 2011, 01:46
Rufname:

AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       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:

Tabellen leeren, Autowert zuruecksetzen - Tabellen leeren, Autowert zuruecksetzen

Nach oben
       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:


AW: Autowert zuruecksetzen (auch bei Access 2000!) - AW: Autowert zuruecksetzen (auch bei Access 2000!)

Nach oben
       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).
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
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 
Keine neuen Beiträge Access Tabellen & Abfragen: Feld mit AutoWert sinnvoll? 1 Schneehasal18 707 21. März 2006, 10:09
stpimi Feld mit AutoWert sinnvoll?
Dieses Thema ist gesperrt, du kannst keine Beiträge editieren oder beantworten. Access Tabellen & Abfragen: Problem mit Access 2000 1 Gast 492 14. Jan 2006, 23:49
Helge Problem mit Access 2000
Keine neuen Beiträge Access Tabellen & Abfragen: Autowert in eine Tabelle übertragen... 4 Mr.E 1603 27. Okt 2005, 08:53
Mr.E Autowert in eine Tabelle übertragen...
Keine neuen Beiträge Access Tabellen & Abfragen: Aufträge nach Monaten abfragen - Access 2000 2 langnet 896 23. Okt 2005, 22:50
langnet Aufträge nach Monaten abfragen - Access 2000
Keine neuen Beiträge Access Tabellen & Abfragen: Problem:Fragmentierte Index-Vergabe (Access 2000) 6 waldwuffel 902 08. Sep 2005, 18:30
waldwuffel Problem:Fragmentierte Index-Vergabe (Access 2000)
Keine neuen Beiträge Access Tabellen & Abfragen: ind.CreateField: Zuweisung Felddatentyp "AutoWert" 3 RoWi 4450 30. Jun 2005, 15:16
RoWi ind.CreateField: Zuweisung Felddatentyp "AutoWert"
Keine neuen Beiträge Access Tabellen & Abfragen: Abfrage wichtig Access 2000 1 sami? 579 03. Mai 2005, 14:08
Dalmatinchen Abfrage wichtig Access 2000
Keine neuen Beiträge Access Tabellen & Abfragen: Position eines Leerzeichen von rechts suchen - Access 2000 3 ClayPigeons 2107 11. Jan 2005, 12:53
Skogafoss Position eines Leerzeichen von rechts suchen - Access 2000
Keine neuen Beiträge Access Tabellen & Abfragen: Access 97 - 2000 'Analysieren mit MS Excel' Problem 0 Visio 1084 28. Dez 2004, 09:03
Visio Access 97 - 2000 'Analysieren mit MS Excel' Problem
Keine neuen Beiträge Access Tabellen & Abfragen: Tabelle per SQL umbennen (Access 2000) 2 DerPater 1084 09. Dez 2004, 14:02
Gast Tabelle per SQL umbennen (Access 2000)
Keine neuen Beiträge Access Tabellen & Abfragen: Autowert für Auftrag und Auftragsposition (abhängig!) 4 astrosoft 1613 08. Dez 2004, 16:53
Skogafoss Autowert für Auftrag und Auftragsposition (abhängig!)
Keine neuen Beiträge Access Tabellen & Abfragen: Undefinierte Abfrage - Access 2000 4 ClayPigeons 794 18. Nov 2004, 18:00
ClayPigeons Undefinierte Abfrage - Access 2000
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Project