• Erstellen einer Datenbank
• Erstellen einer Tabelle mit Feldern
• Füllen der Tabelle
• Löschen der Tabelle
• Löschen der Datenbank

Zunächst muss festgelegt werden, um welche Version es sich handelt.
Im VBA-Editor unter "Extras" - "Verweise" aktivieren Sie nun einen
der folgenden Verweise (es ist nur einer erlaubt !)

• Microsoft DAO 3.51 Object Library [für Access 97 Datenbanken]
• Microsoft DAO 3.6 Object Library [für Access 2000 Datenbanken]

'Dateiname der Datenbank
Public Const Dateiname = "C:\Datenbank.mdb"
'Tabellenname in der Datenbank
Public Const Tabellenname = "Meine_Tabelle"

Dim Datenbank As Database
Dim Datensatz As Recordset
Dim Tabelle As TableDef

'Erzeugen der Datenbank und Tabelle
Public Sub Datenbank_und_Tabelle_erzeugen()
    Dim Feld1 As Field
    Dim Feld2 As Field
    Dim Feld3 As Field
    Dim Feld4 As Field
    On Error Resume Next
    'Prüfen, ob Datenbank bereits vorhanden
    If Dir(Dateiname) = "" Then
        'falls nicht, neu erzeugen
        Set Datenbank = CreateDatabase(Dateiname, dbLangGeneral, dbEncrypt)
    Else
        'ansonsten öffnen
        Set Datenbank = OpenDatabase(Dateiname)
    End If
    

    'Prüfen, ob Tabelle bereits vorhanden
    If Not TableExists(Dateiname, Tabellenname) Then
        'Tabelle erzeugen
        Set Datenbank = OpenDatabase(Dateiname)
        Set Tabelle = Datenbank.CreateTableDef(Tabellenname)
        'Felder erzeugen
        'Die Namen der Felder werden aus den
        'entsprechenden Zellen geholt
        With Tabelle
            Set Feld1 = .CreateField(Range("B2"), dbText, 20)
            Set Feld2 = .CreateField(Range("C2"), dbText, 20)
            Set Feld3 = .CreateField(Range("D2"), dbDate)
            Set Feld4 = .CreateField(Range("E2"), dbMemo)
            .Fields.Append Feld1
            .Fields.Append Feld2
            .Fields.Append Feld3
            .Fields.Append Feld4
        End With
        'Tabelle hinzufügen
        Datenbank.TableDefs.Append Tabelle
    End If
    'Datenbank schließen
    Datenbank.Close
    If Err.Number <> 0 Then MsgBox Err.Description
End Sub

'Daten aus einem Bereich in die Datenbank schreiben
Public Sub Daten_schreiben()
    'Prüfen, Tabelle existiert
    If Not TableExists(Dateiname, Tabellenname) Then
        MsgBox "Datenbank oder Tabelle ist nicht vorhanden !", vbExclamation
        Exit Sub
    End If
    'Datenbank und Tabelle öffnen
    Set Datenbank = OpenDatabase(Dateiname)
    Set Datensatz = Datenbank.OpenRecordset(Tabellenname)
    With Datensatz
        'Bereich B3:E22
        For x = 3 To 22
            .AddNew
            For y = 2 To 5 'Spalte 2 bis 5
                .Fields(Cells(2, y)).Value = Cells(x, y).Text
            Next y
            'Datensatz updaten
            .Update
            .Bookmark = .LastModified
        Next x
    End With
    Datenbank.Close
End Sub

'Tabelle löschen
Public Sub Tabelle_löschen()
    'Datenbank zum Löschen öffnen
    Set Datenbank = OpenDatabase(Dateiname)
    'Tabelle löschen
    Datenbank.TableDefs.Delete Tabellenname
    'Datenbank schließen
    Datenbank.Close
End Sub

'Prüft, ob eine Tabelle in einer
'Datenbank bereits vorhanden ist
Public Function TableExists(Dateiname, MyTableName)
    Dim i
    'Prüfen, ob die Datenbank existiert
    If Dir(Dateiname) = "" Then
        TableExists = False
        Exit Function
    End If
    'Datenbank öffnen
    Set Datenbank = OpenDatabase(Dateiname)
    TableExists = False
    'alle Tabellen durchlaufen
    For i = 0 To Datenbank.TableDefs.Count - 1
        If Datenbank.TableDefs(i).Name = MyTableName Then
            TableExists = True
            Exit Function
        End If
    Next i
    'Datenbank schließen
    Datenbank.Close
End Function

Download - 28 KB