Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Tabelle mit Daten - Zahlenfeld in AutoNumber konvertieren
zurück: Code Modul Struktur weiter: 1. Suchformular in 10 Minuten erstellt Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Bitsqueezer
Office-VBA-Programmierer


Verfasst am:
06. März 2014, 13:17
Rufname:


Tabelle mit Daten - Zahlenfeld in AutoNumber konvertieren - Tabelle mit Daten - Zahlenfeld in AutoNumber konvertieren

Nach oben
       Version: (keine Angabe möglich)

Hallo,

es kommt schon mal vor, daß man eine Tabelle in Access hat, die man gern von einem Long Integer Feld in ein AutoNumber Feld konvertieren möchte - Access läßt das aber nicht zu, wenn bereits Daten in der Tabelle sind.

Hat man Daten, die bereits mit anderen Tabellen verknüpft sind, kann man nicht einfach ein AutoNumber-Feld einfügen und das alte löschen, denn dann hätte man eine neue Serie von IDs, die nicht unbedingt mit der alten übereinstimmt.

Abhilfe: Man muß die IDs der alten Spalte in die neue per INSERT schreiben, denn lustigerweise erlaubt Access, per INSERT eine beliebige Zahl in eine AutoNumber-Spalte einzufügen.

Das manuell zu erledigen, ist eine ziemliche Arbeit, daher habe ich mir eine kleine Sub gebastelt, die das mit einer beliebigen Tabelle automatisch erledigt:
Code:
Public Sub ConvertNumberToAutonumber(strTable As String)
    Dim td As DAO.TableDef
    Dim db As DAO.Database
    Dim ind As DAO.Index
    Dim fld As DAO.Field
    Dim fldNew As DAO.Field
    Dim indField As Object
    Dim lngOrdinalPos As Long
    Dim intAnswer As Integer
    Dim strFieldName As String

    Set db = CurrentDb
    DoCmd.TransferDatabase acImport, "Microsoft Access" _
                         , CurrentProject.FullName, acTable, strTable _
                         , "New_" & strTable, True
    Set td = db.TableDefs("New_" & strTable)
    With td
        For Each fld In td.Fields
            If Left(fld.Name, 2) = "ID" And fld.Type = dbLong Or _
               fld.Type = dbInteger Or fld.Type = dbByte Then
                intAnswer = MsgBox("Convert " & fld.Name & " to AutoNumber?" _
                                 , vbQuestion Or vbYesNoCancel)
                Select Case intAnswer
                  Case vbYes
                    strFieldName = fld.Name
                    lngOrdinalPos = fld.OrdinalPosition
DeleteIndexes:
                    For Each ind In .Indexes
                        For Each indField In ind.Fields
                            If indField.Name = strFieldName Then
                                .Indexes.Delete ind.Name
                                GoTo DeleteIndexes
                            End If
                        Next
                    Next
                    .Fields.Delete strFieldName
                    Set fldNew = .CreateField("New_" & strFieldName, dbLong)
                    fldNew.Attributes = fldNew.Attributes Or dbAutoIncrField
                    fldNew.OrdinalPosition = lngOrdinalPos
                    fldNew.Name = strFieldName
                    .Fields.Append fldNew
                    db.Execute "INSERT INTO New_" & strTable _
                            & " SELECT * FROM " & strTable
                    db.Execute "DROP TABLE " & strTable
                    td.Name = strTable
                    Exit For
                  Case vbNo
                  Case vbCancel
                    Exit For
                End Select
            End If
        Next
        On Error Resume Next
        db.Execute "DROP TABLE New_" & strTable
    End With
    Set ind = Nothing
    Set fld = Nothing
    Set fldNew = Nothing
    Set td = Nothing
    Set db = Nothing
End Sub

Achtung: Vor dem Einsatz einen Backup der Datenbank erstellen!
Aufruf erfolgt mit
Code:
ConvertNumberToAutonumber "NamederTabelle"
im Direktfenster von VBA.

Es wird zuerst eine Kopie der Tabelle erstellt, die nur die Struktur der Originaltabelle enthält, mit dem Prefix "New_". Daraufhin wird die Liste der Felder nach Feldern durchsucht, die mit "ID" anfangen und vom Typ Byte, Integer oder Long sind. Wird so ein Feld gefunden, fragt eine Messagebox, ob dieses Feld für die Konvertierung verwendet werden soll. Falls nicht, wird nach dem nächsten Feld gesucht, ansonsten werden dann zuerst alle Indizes dieses Feldes gelöscht, eine neue Spalte mit dem Prefix "New_" angelegt und als AutoNumber-Feld erstellt.
Daraufhin werden die Daten aus der alten Tabelle in die neue kopiert und die ID in das AutoNumber-Feld geschrieben.
Zuletzt wird die alte Tabelle gelöscht (daher auch der Backup notwendig, für alle Fälle...).

Die folgende Sub listet außerdem alle Tabellen, die noch keinen PK haben (die Ausgabe erfolgt im VBA-Direktfenster):
Code:
Public Sub ListTablesWithoutPK()
    Dim td As DAO.TableDef
    Dim db As DAO.Database
    Dim ind As DAO.Index
    Dim fld As DAO.Field
    Dim bolPKFound As Boolean
   
    Set db = CurrentDb
    For Each td In db.TableDefs
        If Not (td.Name Like "MSys*" Or td.Name Like "~*") Then
            For Each ind In td.Indexes
                If ind.Primary Then
                    bolPKFound = True
                    Exit For
                End If
            Next
            If Not bolPKFound Then
                Debug.Print td.Name
            End If
        End If
        bolPKFound = False
    Next
End Sub
Einen PK kann man dann automatisch auf alle Tabellen hinzufügen lassen, die noch keinen PK haben und ein AutoNumber-Feld haben:
Code:
Public Sub CreatePKs()
    Dim td As DAO.TableDef
    Dim db As DAO.Database
    Dim ind As DAO.Index
    Dim fld As DAO.Field
   
    Set db = CurrentDb
    For Each td In db.TableDefs
        If Not (td.Name Like "MSys*" Or td.Name Like "~*") Then
            Set ind = GetPrimaryIndex(td)
            If ind Is Nothing Then
                For Each fld In td.Fields
                    If (fld.Attributes And dbAutoIncrField) = dbAutoIncrField Then
                        Set ind = td.CreateIndex("PrimaryKey")
                        ind.Fields.Append ind.CreateField(fld.Name, fld.Type _
                                                        , fld.Size)
                        ind.Primary = True
                        td.Indexes.Append ind
                        Set ind = Nothing
                        Exit For
                    End If
                Next
            End If
          Else
            bolPKFound = False
        End If
    Next
End Sub

Public Function GetPrimaryIndex(td As DAO.TableDef) As DAO.Index
    Dim ind As DAO.Index
    Dim bolPKFound As Boolean

    For Each ind In td.Indexes
        If ind.Primary Then
            bolPKFound = True
            Exit For
        End If
    Next
    If bolPKFound Then
        Set GetPrimaryIndex = ind
      Else
        Set GetPrimaryIndex = Nothing
    End If
End Function
Spart ein wenig Tipparbeit beim Importieren von Tabellen aus anderen Datenbanken...Wink

Viel Spaß damit

Christian
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: tabelle exportieren 1 Gast 1501 01. Jun 2004, 12:25
Willi Wipp tabelle exportieren
Keine neuen Beiträge Access Tabellen & Abfragen: Duplikate einer Tabelle löschen?! 3 Esel 2108 28. Mai 2004, 08:53
lothi Duplikate einer Tabelle löschen?!
Keine neuen Beiträge Access Tabellen & Abfragen: Spaltennamen einer Tabelle ermitteln 1 Alexander Neron 899 27. Mai 2004, 13:47
lothi Spaltennamen einer Tabelle ermitteln
Keine neuen Beiträge Access Tabellen & Abfragen: kein Wert in der Tabelle, dann immer Null (0)?? 3 Michel_9 1005 26. Mai 2004, 14:28
Michel_9 kein Wert in der Tabelle, dann immer Null (0)??
Keine neuen Beiträge Access Tabellen & Abfragen: Daten der Abfrage ausgeben 3 Papa Schlumpf 1007 24. Mai 2004, 17:34
Willi Wipp Daten der Abfrage ausgeben
Keine neuen Beiträge Access Tabellen & Abfragen: Operant aus Tabelle in Abfrage verwenden 3 AccessGeek 673 06. Mai 2004, 09:15
lothi Operant aus Tabelle in Abfrage verwenden
Keine neuen Beiträge Access Tabellen & Abfragen: Tabelle formatiert in txt-Datei exportieren 1 robby 1115 12. Apr 2004, 23:10
Helge Tabelle formatiert in txt-Datei exportieren
Keine neuen Beiträge Access Tabellen & Abfragen: Tabelle aus Abfrage erstellen 1 dasti 3317 09. Apr 2004, 12:14
Gast Tabelle aus Abfrage erstellen
Keine neuen Beiträge Access Tabellen & Abfragen: Zeilenumbruch nach Einfügen Word Tabelle 2 topflop 1698 30. März 2004, 16:06
Gast Zeilenumbruch nach Einfügen Word Tabelle
Keine neuen Beiträge Access Tabellen & Abfragen: nicht-atomare Daten aus EXCEL importieren 2 Panther 908 29. März 2004, 16:33
Panther nicht-atomare Daten aus EXCEL importieren
Keine neuen Beiträge Access Tabellen & Abfragen: neue Tabellen erstellen aus vorhandener Tabelle 6 moni 2010 29. März 2004, 15:39
moni neue Tabellen erstellen aus vorhandener Tabelle
Keine neuen Beiträge Access Tabellen & Abfragen: Wert einer Abfrage in Tabelle kopieren? 1 BerlinerWolf 2009 21. März 2004, 12:43
Maya Wert einer Abfrage in Tabelle kopieren?
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Excel Tipps