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