Translate

Dienstag, 23. April 2013

MS EXCEL: Inhalt eines ADO- oder DAO-Recordset-Objekts in ein Arbeitsblatt kopieren

Mit der Methode CopyFromRecordset läßt sich sehr einfach und schnell den kompletten Inhalt eines ADO- oder DAO-Recordset-Objekts in einem Tabellenblatt ausgeben.

Hier ein Beispiel mit dem Objekt DAO (Verweis auf Microsoft DAO 3.6 erforderlich)
Public Sub HoleDaten()
    Dim db As DAO.Database, rs As DAO.Recordset
    Dim rgTarget As Range, anz As Long, iCols As Integer
   
    Set db = Dao.OpenDatabase("MeineDatenbankDatei.mdb")
    Set rs = db.OpenRecordset("MeineTabelle")
    Set rgTarget = Tabelle1.Range("A1")
    For iCols = 0 To rs.Fields.Count - 1
        rgTarget.Parent.Cells(rgTarget.Row, rgTarget.Column + iCols).Value = rs.Fields(iCols).Name
    Next
    Set rgTarget = rgTarget.Offset(1)
    anz = rgTarget.CopyFromRecordset(rs)
    MsgBox "Anzahl eingefügte Datensätze: " & anz
End Sub


Laut Tip aus meinem Post datenbankzugriff-per-vba-via-dao hier eine fertige Funktion mit Variante ohne erforderlichen Verweis auf Microsoft DAO 3.6: 
Public Function CopyFromRecordsetEX(DatenbankDatei As String, sql As String, Zielbereich As Object, Optional MitÜberschriften As Boolean = True _
                            , Optional MaxZeilen As Long, Optional MaxSpalten As Long _
                            , Optional ByRef AnzahlDatensätze As Long) As Boolean
    Dim oDAO As Object, db As Object, rs As Object, fld As Object
    Dim Klassenname As String
   
    On Error GoTo Err_Handle
    Klassenname = "DAO.DBEngine.36"
    If Application.Version > "11.0" Then Klassenname = "DAO.DBEngine.120"
    Set oDAO = CreateObject(Klassenname)
   
    Set db = oDAO.OpenDatabase(DatenbankDatei)
    Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
   
    If Zielbereich Is Nothing Then Set Zielbereich = ActiveCell
    Set Zielbereich = Zielbereich(1)
    MaxZeilen = Zielbereich.Parent.Rows.Count - Zielbereich.Row
    MaxSpalten = Zielbereich.Parent.Columns.Count - Zielbereich.Column
    If MitÜberschriften Then
        For Each fld In rs.Fields
            Zielbereich = fld.Name
            Set Zielbereich = Zielbereich.Offset(, 1)
        Next
        Set Zielbereich = Zielbereich.Offset(1, -rs.Fields.Count)
    End If
    AnzahlDatensätze = Zielbereich.CopyFromRecordset(rs, MaxZeilen, MaxSpalten)
    CopyFromRecordsetEX = True

Exit_Proc:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    Set oDAO = Nothing
    Exit Function
   
Err_Handle:
    Beep
    MsgBox Err.description, vbCritical, "Error number: " & Err.Number
    Resume Exit_Proc
End Function

Keine Kommentare:

Kommentar veröffentlichen