VBA Tipp: XML Einlesen

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte den Inhalt einer Tabelle oder Abfrage, die mithilfe eines ADO-Recordsets in einer XML-Datei gespeichert wurde, wieder in ein ADO-Recordset einlesen, und die Feldnamen und Feldinhalte im Direktfenster ausgeben lassen.

Lösung

Das geht mit folgender Sub-Prozedur, die in einem globalen Modul gespeichert wird.

Public Sub XMLAnzeigen(ByVal Dateipfad As String)
 
 'Late Binding: Kein Verweis auf Microsoft ActiveX Data Objekts x.x Library (ADO) notwendig.
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim rs        As Object
 Dim i         As Long
 Dim j         As Long
 Dim strFelder As String
 Const adOpenStatic = 3
 Const adLockOptimistic = 3
 Const adCmdFile = 256
 
 Set rs = CreateObject("ADODB.Recordset")
 
 rs.Open Source:=Dateipfad, _
         CursorType:=adOpenStatic, _
         LockType:=adLockOptimistic, _
         Options:=adCmdFile
 
 'Feldnamen im Direktfenster waagrecht auflisten
 For i = 0 To rs.Fields.Count - 1
   strFelder = strFelder & rs.Fields(i).Name & "|"
 Next i
 Debug.Print "Feldnamen: " & strFelder
 strFelder = ""
 
 'Feldinhalte im Direktfenster waagrecht auflisten
 Do While Not rs.EOF
 
   j = j + 1
 
   For i = 0 To rs.Fields.Count - 1
     strFelder = strFelder & rs.Fields(i) & "|"
   Next i
 
   Debug.Print "Datensatz " & j & ": " & strFelder
   strFelder = ""
 
   rs.MoveNext
 Loop
 
 'rs schließen und Speicher freigeben
 If Not rs Is Nothing Then rs.Close: Set rs = Nothing
 
End Sub

Aufruf

Der Inhalt der XML-Datei wird im Direktenster angezeigt.

 Call XMLAnzeigen(CurrentProject.Path & "\Lieferanten.xml")


Wiki hinweis.png

Hinweis:

  • Mit obiger Prozedur können nur XML-Dateien angezeigt / aufgelistet werden, die über ein ADO-Recordset gefüllt wurden.
  • Beliebige XML-Dateien aus anderen Quellen können damit nicht angezeigt werden, und erzeugen eine Fehlermeldung: "Die Quelle XML ist unvollständig oder ungültig".


XML-Datei erzeugen

Mit folgender Prozedur kann eine XML-Datei mittels eines ADO-Recordsets erzeugt, und mit dem Inhalt einer Tabelle (z.B. die Tabelle Lieferanten aus der Nordwind-Datenbank) gefüllt werden. Falls die XML-Datei bereits existiert, wird ein Fehler ausgelöst.

Public Sub XMLErzeugen(ByVal Tabellenname As String, _
                       ByVal Dateipfad As String)
 
 'Late Binding: Kein Verweis auf Microsoft ActiveX Data Objekts x.x Library (ADO) notwendig.
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim rs As Object
 Const adOpenDynamic = 2
 Const adLockOptimistic = 3
 Const adPersistXML = 1
 
 Set rs = CreateObject("ADODB.Recordset")
 
 rs.Open "SELECT * FROM " & Tabellenname, _
         CurrentProject.Connection, _
         adOpenDynamic, _
         adLockOptimistic
 
 rs.Save Dateipfad, adPersistXML
 
 'rs schließen und Speicher freigeben
 If Not rs Is Nothing Then rs.Close: Set rs = Nothing
 
End Sub

Aufruf

 Call XMLErzeugen("Lieferanten", CurrentProject.Path & "\Lieferanten.xml")


Web-Links