VBA-Wissen.de
 
DAO-( Data Access Objects ) Programmierung
 
Wichtiger Hinweis:
Im VBA- Editor muss folgender Verweis gesetzt sein:
            
 
Befehl / Beispiele Beschreibung
CreateDatabase Datenbank erstellen
Beispiel:
Sub NeueDatenbankAnlegen_Start()
    Dim DBName As String

    DBName = Application.ThisWorkbook.Path & "\Test.MDB"
    If Dir(DBName) <> "" Then Kill DBName
    NeueDatenbankAnlegen DBName
End Sub

Sub NeueDatenbankAnlegen(DBName)
'+----------------------------------------------------------+
'|  Erstellt eine neue leere MS-Access-Datenbank ( *.mdb )  |
'+----------------------------------------------------------+
    Dim WS As Workspace: Set WS = DBEngine.Workspaces(0)
    Dim DB As Database:  Set DB = WS.CreateDatabase(DBName, dbLangGeneral, dbVersion40)
    DB.Close
End Sub
Version Version einer Datenbank ausgeben
Beispiel:
Sub Start()
    Dim DBName As String

    DBName = Application.ThisWorkbook.Path & "\Test.MDB"
    MsgBox "Version der Datenbank: " & DatenbankVersion(DBName)
End Sub

Function DatenbankVersion(DBName)
'+---------------------------------------------+
'|  Ermittelt die Version einer MDB-Datenbank  |
'+---------------------------------------------+
    Dim DB As Database: Set DB = OpenDatabase(DBName, dbDriverComplete, False)
    DatenbankVersion = DB.Version
    DB.Close
End Function
TableDefs.Count Anzahl der Tabellen einer Datenbank ausgeben
Beispiel:
Sub Start()
    Dim DBName As String

    DBName = Application.ThisWorkbook.Path & "\Test.MDB"
    MsgBox "Anzahl Tabellen: " & AnzahlTabellen(DBName)
End Sub

Function AnzahlTabellen(DBName)
'+-----------------------------------------------------+
'|  Ermittelt die Anzahl der Tabellen einer Datenbank  |
'+-----------------------------------------------------+
    Dim DB As Database: Set DB = OpenDatabase(DBName, dbDriverComplete, False)
    AnzahlTabellen = DB.TableDefs.Count
    DB.Close
End Function
TableDefs(<Index>).Name Tabellennamen einer Datenbank ausgeben
Beispiel:
Sub Start()
    Dim DBName   As String
    Dim Nr       As Integer
    Dim TBNamen  As Variant
    Dim Text     As String

    DBName = Application.ThisWorkbook.Path & "\Test.MDB"
    TBNamen = TabellenNamenErmitteln(DBName)
    For Nr = LBound(TBNamen) To UBound(TBNamen)
        Text = Text & TBNamen(Nr) & vbCr
    Next Nr
    MsgBox Text
End Sub

Function TabellenNamenErmitteln(DBName) As Variant
'+-----------------------------------------------+
'|  Ermittelt die Tabellennamen einer Datenbank  |
'+-----------------------------------------------+
    Dim Nr As Integer
    Dim TBNamen As String

    Dim DB As Database: Set DB = OpenDatabase(DBName, dbDriverComplete, False)
    For Nr = 1 To DB.TableDefs.Count
        If Len(TBNamen) > 0 Then TBNamen = TBNamen & vbCr
    TBNamen = TBNamen & DB.TableDefs(Nr - 1).Name
    Next Nr
    TabellenNamen = Split(TBNamen, vbCr)
    DB.Close
End Function
CopyFromRecordset Datenbank-Tabelle in ein Excel-Tabellenblatt übertragen.
Beispiel:
Sub Start()
    Dim DBName As String

    DBName = Application.ThisWorkbook.Path & "\Test.MDB"
    DBTabelleInExcelTabelle DBName, "Tabelle"
End Sub

Function DBTabelleInExcelTabelle(DBName, TBName) As Variant
'+---------------------------------------------------------------------+
'|  Kopiert eine gesamte Datenbank-Tabelle in ein Excel-Tabellenblatt  |
'+---------------------------------------------------------------------+
    Dim DB As Database: Set DB = OpenDatabase(DBName, dbDriverComplete, False)
    Range("A1").CopyFromRecordset DB.OpenRecordset(TBName)
    DB.Close
End Function
<Tabellenname>.Fields(<Index>).Name Felder ( Spaltennamen ) einer Datenbanktabelle auslesen.
Sub SpaltenNamenEinerTabelleAusgeben(DBName, TBName, Felder)
'+--------------------------------------------------------+
'|  Ermittelt die Feldnamen einer Datenbank-Tabelle       |
'+--------------------------------------------------------+
'|  DBName = Name der Datenbank als komplette Adresse     |
'|  TBName = Name der Datenbank-Tabelle                   |
'|  Felder = Namen der Felder, eindimensionale Matrix     |
'|           Dimensionierung in der aufrufende Prozedur:  |
'|           Dim Felder As Variant                        |
'+--------------------------------------------------------+
    Dim Dummy As String

    Dim DB As Database: Set DB = OpenDatabase(DBName, dbDriverComplete, False)
    Dim TB As TableDef: Set TB = DB.TableDefs(TBName)
    Dim FD As Field

    For Each FD In TB.Fields
        Dummy = IIf(Dummy = "", Dummy & FD.Name, Dummy & "|" & FD.Name)
    Next FD
    DB.Close
    Felder = Split(Dummy, "|")
End Sub
DB.CreateTableDef(<Tabellenname>) Datenbank-Tabelle anlegen.
Sub NeueTabelleAnlegen(DBName, TBName)
'+-------------------------------------------------------------+
'|  Erstellt eine neue Tabelle in einer bestehenden Datenbank  |
'|  inklusive der entsprechenden Tabellenfelder                |
'+-------------------------------------------------------------+
    Dim DB As Database: Set DB = OpenDatabase(DBName)
    Dim TB As TableDef: Set TB = DB.CreateTableDef(TBName)

    TB.Fields.Append TB.CreateField("Schalter", dbBoolean)
    TB.Fields.Append TB.CreateField("KleineGanzZahl", dbByte)
    TB.Fields.Append TB.CreateField("GanzZahl", dbInteger)
    TB.Fields.Append TB.CreateField("GrosseGanzZahl", dbLong)
    TB.Fields.Append TB.CreateField("BankerZahl", dbCurrency)
    TB.Fields.Append TB.CreateField("KleineDeziZahl", dbSingle)
    TB.Fields.Append TB.CreateField("GrossDeziZahl", dbDouble)
    TB.Fields.Append TB.CreateField("Datum", dbDate)
    TB.Fields.Append TB.CreateField("BinaerZahl", dbBinary)
    TB.Fields.Append TB.CreateField("Text", dbText)
    TB.Fields.Append TB.CreateField("LangeBinaerZahl", dbLongBinary)
    TB.Fields.Append TB.CreateField("Memo", dbMemo)
    DB.TableDefs.Append TB

    DB.Close
End Sub
Daten in Datenbank-Tabelle schreiben.
 
Daten aus Datenbank-Tabelle lesen.   Siehe auch SQL
 
<Datenbank>.TableDefs.Delete Datenbank-Tabelle löschen.
Sub TabelleLöschen(DBName, TBName)
'+-------------------------------------------------------+
'|  Löscht eine Tabelle aus einer bestehenden Datenbank  |
'+-------------------------------------------------------+
    Dim DB As Database: Set DB = OpenDatabase(DBName)

    DB.TableDefs.Delete TBName
    DB.Close
End Sub