722620 jf — VBA mit ADO

ADO arbeitet mit der Bibliothek Msado15.dll, die in MDAC 2.8 oder höher enthalten ist.

Die Eigenschaft CurrentDb existiert in DAO, aber ADO nicht. ADO arbeitet mit der Connection.

ADO

•Der Namensraum ADODB wird vom intelligenten Editor nicht unterstützt.

•Wollen wir den Namensraum verfügbar machen, so müssen wir den Verweise auf Microsoft ActiveX Data Objects 2.8 Library aktivieren.

•Jetzt können wir auf die Elemente des Namensraums ADODB zugreifen. Der folgende Code-Schnipsel macht dasselbe wie der DAO-Schnipsel:Sub test()

Dim db As New ADODB.Connection

Set db = CurrentProject.Connection

End Sub

MySQL

VBMySQLDirect

Connector/ODBC

conn.ConnectionString = "Provider=MSDASQL;" + _ "DRIVER={MySQL ODBC 3.51 Driver};" + _ "Server=localhost;UID=username;PWD=xxx;" + _ "database=databasename;Option=16387" Table

Datensätze lesen (mit ADO)

db1.mdb [Modul1 (Code)]

Option Explicit
Sub Lese()
  Dim rs As New ADODB.Recordset
  rs.Open "person", CurrentProject.Connection, _ 
    adOpenKeyset, adLockOptimistic
  Do While Not rs.EOF 
    Debug.Print rs![name] 
    rs.MoveNext 
  Loop
  rs.Close
  Set rs = Nothing
End Sub
Sub Serienbrief() 
  Dim rs As New ADODB.Recordset
  Dim w As Word.Application 
  On Error Resume Next 
  Set w = GetObject(, "Word.Application.9") 
  If Err.Number = 429 Then 
    Set w = CreateObject("Word.Application.9") 
    Err.Number = 0 
  End If 
  w.Visible = True
  rs.Open "person", CurrentProject.Connection, _ 
    adOpenKeyset, adLockOptimistic 
  Do While Not rs.EOF 
    w.ActiveDocument.FormFields(1).Result = rs![Namen] 
    rs.MoveNext 
    Stop 
  Loop
  rs.Close 
  Set rs = Nothing
End Sub

Datensatz verändern (mit ADO)

db1.mdb [Modul1 (Code)]

Sub km_schreibe()
  Dim rs As New ADODB.Recordset
  rs.Open "kc_personen", CurrentProject.Connection, _
    adOpenKeyset, adLockOptimistic
  rs![kf_name] = "Stefan"
  rs.Update 
  rs.Close
  Set rs = Nothing
End Sub

Fehlerquellen Kein Primärschlüssel

Datensätze lesen (mit ADO)

db1.mdb [Modul1 (Code)]

Option Explicit
Sub Lese()
  Dim rs As New ADODB.Recordset
  rs.Open "person", CurrentProject.Connection, _ 
    adOpenKeyset, adLockOptimistic
  Do While Not rs.EOF 
    Debug.Print rs![name] 
    rs.MoveNext 
  Loop
  rs.Close
  Set rs = Nothing
End Sub


Sub Serienbrief() 
  Dim rs As New ADODB.Recordset
  Dim w As Word.Application 
  On Error Resume Next 
  Set w = GetObject(, "Word.Application.9") 
  If Err.Number = 429 Then 
    Set w = CreateObject("Word.Application.9") 
    Err.Number = 0 
  End If 
  w.Visible = True
  rs.Open "person", CurrentProject.Connection, _ 
    adOpenKeyset, adLockOptimistic 
  Do While Not rs.EOF 
    w.ActiveDocument.FormFields(1).Result = rs![Namen] 
    rs.MoveNext 
    Stop 
  Loop
  rs.Close 
  Set rs = Nothing
End Sub

Datensatz verändern (mit ADO)

db1.mdb [Modul1 (Code)]

Sub km_schreibe()
  Dim rs As New ADODB.Recordset
  rs.Open "kc_personen", CurrentProject.Connection, _
    adOpenKeyset, adLockOptimistic
  rs![kf_name] = "Stefan"
  rs.Update 
  rs.Close
  Set rs = Nothing
End Sub

Fehlerquellen Kein Primärschlüssel

Writing XML from Access

To write an Access database to XML it can be simply printed using VBA (or your favorite language).

For example, the following Code appends a table to the current database, writes two lines to it and then dumps the table to an XML file.

The file written is shown first.

stefan_ram.xml

<table> 
  <record> 
    <name>Peter</name> 
    <phone>123456</phone> 
  <record> 
  </record> 
    <name>Mary</name> 
    <phone>987654</phone> 
  </record> 
</table>

And this is the VBA code. (not extensively tested, so it may contain errors, therefore only use on your own risk after backing up your data.)

The XML written is by no means perfect, but this is just an example to get you started. The file is created in the current database directory. One might search for it using the Windows Find program.

example.vba

Option Compare Database 
Option Explicit 
Sub Main0() 
  Dim kvl_tabledef As New TableDef 
  Dim kvl_xml As Integer 
  Dim kvl_recordset As New ADODB.Recordset 
  Dim kvl_sql As String 
  Set kvl_tabledef = CurrentDb.CreateTableDef("stefan_ram_table") 
  kvl_tabledef.Fields.Append kvl_tabledef.CreateField("name", dbText) 
  kvl_tabledef.Fields.Append kvl_tabledef.CreateField("phone", dbText) 
  On Error Resume Next 
  CurrentDb.TableDefs.Append kvl_tabledef 'add the table to the DB 
  kvl_recordset.Open "stefan_ram_table", CurrentProject.Connection, adOpenKeyset, adLockOptimistic 
  kvl_recordset.AddNew 
  kvl_recordset.Fields("name").value = "Peter" 
  kvl_recordset.Fields("phone").value = "123456" 
  kvl_recordset.Update 
  kvl_recordset.AddNew 
  kvl_recordset.Fields("name").value = "Mary" 
  kvl_recordset.Fields("phone").value = "987654" 
  kvl_recordset.Update 
  kvl_recordset.Close 
  Set kvl_recordset = Nothing 
  kvl_xml = FreeFile() 
  Open "stefan_ram.xml" For Output As kvl_xml 
  Print #kvl_xml, "<table>" 
  kvl_recordset.Open "stefan_ram_table", CurrentProject.Connection, adOpenKeyset, adLockOptimistic 
  Do While Not kvl_recordset.EOF 
    Print #kvl_xml, "  <record>" 
    Print #kvl_xml, "    <name>" & kvl_recordset.Fields("name") & "</name>" 
    Print #kvl_xml, "    <phone>" & kvl_recordset.Fields("phone") & "</phone>" 
    Print #kvl_xml, "  </record>" 
    kvl_recordset.MoveNext 
  Loop 
  Print #kvl_xml, "</table>" 
  Close kvl_xml 
  kvl_recordset.Close 
  Set kvl_recordset = Nothing 
End Sub

DAO

Visual Basic für Applikationen
Microsoft DAO 3.6 Object Library

ADO

Microsoft ActiveX Data Objects 2.1 Library
Microsoft ADO Ext. 2.1 for DDL and Security
Microsoft Jet and Replication Objects 2.1 Library

DB öffnen

DAO

Sub DAOOpen()

Dim db As DAO.Database

Set db = DBEngine.OpenDatabase("Nordwind.mdb")

db.Close

End Sub

ADO

Sub ADOOpen()

Dim cnn As New ADODB.Connection

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; _

Data Source=Nordwind.mdb;"

cnn.Close

End Sub

Aktuelle DB
DAO

Sub DAOAktuelleDB()

Dim db As DAO.Database

Set db = CurrentDb()

End Sub

ADO

Sub ADOAktuelleDB()

Dim cnn As ADODB.Connection

Set cnn = CurrentProject.Connection

End Sub

Tabelle öffnen

DAO

Sub DAOOpenRecordset()

Dim db As DAO.Database

Dim rst As DAO.Recordset

Dim fld As DAO.Field

' Öffnen der Datenbank

Set db = DBEngine.OpenDatabase("Nordwind.mdb")

' Öffnen des Recordsets

Set rst = db.OpenRecordset("SELECT * FROM Kunden " & _

"WHERE Region = 'WA'", dbOpenForwardOnly, dbReadOnly)

ADO

Sub ADOOpenRecordset()

Dim cnn As New ADODB.Connection

Dim rst As New ADODB.Recordset

Dim fld As ADODB.Field

' Öffnen der Verbindung

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; _

Data Source=Nordwind.mdb;"

' Öffnen des Recordsets im schreibgeschützten

'Vorwärtsmodus

rst.Open "SELECT * FROM Kunden WHERE Region = 'WA'", _

cnn, adOpenForwardOnly, adLockReadOnly

Tabelle lesen

DAO

' Ausgabe der Feldwerte im ersten Datensatz

' auf das Debug-Fenster

For Each fld In rst.Fields

Debug.Print fld.Value & ";";

ADO

' Ausgabe der Feldwerte im ersten Datensatz

' auf das Debug-Fenster

For Each fld In rst.Fields

Debug.Print fld.Value & ";";

DAO

Debug.Print

' Schließen des Recordsets

rst.Close

End Sub

ADO

Debug.Print

' Schließen des Recordsets

rst.Close

End Sub

slr code

Access to XML

Option Compare Database
Option Explicit
Sub Main0()
  Dim kvl_tabledef As New TableDef
  Dim kvl_xml As Integer
  Dim kvl_recordset As New ADODB.Recordset
  Dim kvl_sql As String
  Set kvl_tabledef = CurrentDb.CreateTableDef("stefan_ram_table")
  kvl_tabledef.Fields.Append kvl_tabledef.CreateField("name", dbText)
  kvl_tabledef.Fields.Append kvl_tabledef.CreateField("phone", dbText)
  On Error Resume Next
  CurrentDb.TableDefs.Append kvl_tabledef 'add the table to the DB
  kvl_recordset.Open "stefan_ram_table", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  kvl_recordset.AddNew
  kvl_recordset.Fields("name").value = "Peter"
  kvl_recordset.Fields("phone").value = "123456"
  kvl_recordset.update
  kvl_recordset.AddNew
  kvl_recordset.Fields("name").value = "Mary"
  kvl_recordset.Fields("phone").value = "987654"
  kvl_recordset.update
  kvl_recordset.Close
  Set kvl_recordset = Nothing
  kvl_xml = FreeFile()
  Open "stefan_ram.xml" For Output As kvl_xml
  Print #kvl_xml, "<table>"
  kvl_recordset.Open "stefan_ram_table", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  Do While Not kvl_recordset.EOF
    Print #kvl_xml, "  <record>"
    Print #kvl_xml, "    <name>" & kvl_recordset.Fields("name") & "</name>"
    Print #kvl_xml, "    <phone>" & kvl_recordset.Fields("phone") & "</phone>"
    Print #kvl_xml, "  </record>"
    kvl_recordset.MoveNext
  Loop
  Print #kvl_xml, "</table>"
  Close kvl_xml
  kvl_recordset.Close
  Set kvl_recordset = Nothing
End Sub

dump_table_info

Sub dumptables() ' WARNING: Will overwrite (DELETE) tables "TABLES", "VIEWS", and "COLUMNS"!
Dim A As New DAO.TableDef
Dim B As New ADODB.Recordset
Dim C As New ADODB.Recordset
Dim D As New ADODB.Recordset
Dim E As DAO.Database
Dim F As DAO.TableDef
Dim G As DAO.Field
Dim H As DAO.QueryDef
Set E = Access.CurrentDb
Set A = E.CreateTableDef("TABLES")
A.Fields.Append A.CreateField("TABLE_NAME", DAO.dbText)
A.Fields.Append A.CreateField("TABLE_TYPE", DAO.dbText)
On Error Resume Next
E.TableDefs.Delete ("TABLES")
E.TableDefs.Append A
Set A = Nothing
B.Open "TABLES", Access.CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set A = E.CreateTableDef("VIEWS")
A.Fields.Append A.CreateField("TABLE_NAME", DAO.dbText)
A.Fields.Append A.CreateField("VIEW_DEFINITION", DAO.dbMemo)
A.Fields.Append A.CreateField("IS_UPDATABLE", DAO.dbText)
On Error Resume Next
E.TableDefs.Delete ("VIEWS")
E.TableDefs.Append A
Set A = Nothing
C.Open "VIEWS", Access.CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set A = E.CreateTableDef("COLUMNS")
A.Fields.Append A.CreateField("COLUMN_NAME", DAO.dbText)
A.Fields.Append A.CreateField("TABLE_NAME", DAO.dbText)
On Error Resume Next
E.TableDefs.Delete ("COLUMNS")
E.TableDefs.Append A
Set A = Nothing
D.Open "COLUMNS", Access.CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For Each F In E.TableDefs
If Left(F.name, 4) <> "MSys" Then
B.AddNew
B.Fields("TABLE_NAME").value = F.name
B.Fields("TABLE_TYPE").value = "BASE TABLE"
B.update
For Each G In F.Fields
D.AddNew
D.Fields("COLUMN_NAME").value = G.name
D.Fields("TABLE_NAME").value = F.name
D.update
Next G
End If
Next F
For Each H In E.QueryDefs
If Left(H.name, 1) <> "~" Then
C.AddNew
C.Fields("TABLE_NAME").value = H.name
C.Fields("VIEW_DEFINITION").value = H.SQL
If H.Updatable Then
C.Fields("IS_UPDATABLE").value = "YES"
Else
C.Fields("IS_UPDATABLE").value = "NO"
End If
C.update
B.AddNew
B.Fields("TABLE_NAME").value = H.name
B.Fields("TABLE_TYPE").value = "VIEW"
B.update
For Each G In H.Fields
D.AddNew
D.Fields("COLUMN_NAME").value = G.name
D.Fields("TABLE_NAME").value = H.name
D.update
Next G
End If
Next H
D.Close: Set D = Nothing
C.Close: Set C = Nothing
B.Close: Set B = Nothing
End Sub

faqcheck

Option Compare Database

Option Explicit

Sub tmp()

Dim kv_rs As New ADODB.Recordset

Dim kv_sql As String

Dim kv_uri As String

kv_sql = "select * from kc_query_newsgroup_faquri"

kv_rs.Open kv_sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

Do While Not kv_rs.EOF

kv_uri = kv_rs.Fields("kf_value")

Debug.Print kv_uri

kv_rs.MoveNext

Loop

kv_rs.Close

End Sub

garnoo_check

Option Compare Database
Sub km_fillinmax()
  Dim kv_rs As New ADODB.Recordset
  Dim kv_partion As String
  Dim kv_layer2 As Integer
  Dim kv_layer3 As Integer
  Dim kv_layer4 As Integer
  Dim kv_layer5 As Integer
  Dim kv_max As Integer
  kv_rs.Open "kn_enty_by_module", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  Do While Not kv_rs.EOF
    kv_partion = kv_rs![kv_partion]
    If (IsNull(kv_rs![kn_enty_2.kv_max])) Then kv_layer2 = 0 Else kv_layer2 = CInt(kv_rs![kn_enty_2.kv_max])
    If (IsNull(kv_rs![kn_enty_3.kv_max])) Then kv_layer3 = 0 Else kv_layer3 = CInt(kv_rs![kn_enty_3.kv_max])
    If (IsNull(kv_rs![kn_enty_4.kv_max])) Then kv_layer4 = 0 Else kv_layer4 = CInt(kv_rs![kn_enty_4.kv_max])
    If (IsNull(kv_rs![kn_enty_5.kv_max])) Then kv_layer5 = 0 Else kv_layer5 = CInt(kv_rs![kn_enty_5.kv_max])
    kv_max = -99
    If kv_layer2 > kv_max Then kv_max = kv_layer2
    If kv_layer3 > kv_max Then kv_max = kv_layer3
    If kv_layer4 > kv_max Then kv_max = kv_layer4
    If kv_layer5 > kv_max Then kv_max = kv_layer5
    If (kv_partion <> "291") Then
      If (kv_rs![kv_kind] = "331") Then ' Object
        kv_rs![kn_enty.kv_max] = kv_rs![kn_enty_1.kv_max] 'use the objects declared layer
        kv_rs.update
      ElseIf (kv_rs![kv_kind] = "332") Then ' Arrow
        kv_rs![kn_enty.kv_max] = kv_max 'use the max of objects touch by this arrow
        kv_rs.update
      ElseIf (kv_rs![kv_kind] = "36") Then ' unused
        kv_rs![kn_enty.kv_max] = 10 'use the max of objects touch by this arrow
        kv_rs.update
      End If
    End If
    kv_rs.MoveNext
  Loop
  kv_rs.Close
  Set kv_rs = Nothing
End Sub
' we must fullfill that enty1.max (declared layer)
' is <= enty.max (derived layer)
Sub km_clearmax()
  'clear max
  Dim kv_rs As New ADODB.Recordset
  Dim kv_partion As String
  kv_rs.Open "kn_enty_by_module", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  Do While Not kv_rs.EOF
    If (kv_rs![kv_partion] <> "291") Then
      kv_rs![kn_enty.kv_max] = Null
      kv_rs.update
    End If
    kv_rs.MoveNext
  Loop
  kv_rs.Close
  Set kv_rs = Nothing
End Sub

722620 jf — VBA mit ADO

MySQL

Datensätze lesen (mit ADO)

Datensatz verändern (mit ADO)

Datensätze lesen (mit ADO)

Datensatz verändern (mit ADO)

Writing XML from Access

DAO

ADO

DB öffnen

DAO

ADO

Aktuelle DBDAO

ADO

Tabelle öffnen

DAO

ADO

Tabelle lesen

DAO

ADO

Datenbank schließen

DAO

ADO

slr code

Aktuelle DB
DAO