Inhaltsverzeichnis
Mit den folgenden Verfahren können Sie DAO verwenden, um ein Recordset aus einer geschlossenen Arbeitsmappe abzurufen und Daten zu lesen/schreiben.
Rufen Sie die Prozedur wie folgt auf:
GetWorksheetData "C:\Ordnername\Dateiname.xls", "SELECT * FROM [SheetName$]", ThisWorkbook.Worksheets(1).Range("A3")
Ersetzen Sie SheetName durch den Arbeitsblattnamen, aus dem Sie Daten abrufen möchten.
Sub GetWorksheetData(strSourceFile As String, strSQL As String, TargetCell As Range) Dim db As DAO.Database, rs As DAO.Recordset, f As Integer, r As Long Wenn TargetCell nichts ist, dann Sub bei Fehler beenden Resume Next Set db = OpenDatabase (strSourceFile, False, True, "Excel 8.0;HDR=Yes;") ' read only 'Set db = OpenDatabase(strSourceFile, False, False, "Excel 8.0;HDR=Yes;") ' write 'Set db = OpenDatabase( "C:\Ordnername\Dateiname.xls", False, True, _ "Excel 8.0;HDR=Yes;") ' nur lesen 'Set db = OpenDatabase("C:\Ordnername\Dateiname.xls", False, False, _ "Excel 8.0;HDR=Yes;") ' write On Error GoTo 0 If db Is Nothing Then MsgBox "Kann die Datei nicht finden!", vbExclamation, ThisWorkbook.Name Exit Sub End If ' ' Arbeitsblattnamen auflisten ' For f = 0 To db.TableDefs.Count - 1 ' Debug.Print db.TableDefs(f).Name ' Next f ' Open a recordset On Error Resume Next Set rs = db.OpenRecordset(strSQL) ' Set rs = db.OpenRecordset( "SELECT * FROM [SheetName$]") ' Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _ "WHERE [Feldname] LIKE 'A*'") ' Set rs = db.OpenRecordset("SELECT * FROM [SheetName$] " & _ "WHERE [Feldname] LIKE 'A*' ORDER BY [Feldname]" ) Bei Fehler GoTo 0 Wenn rs nichts ist, dann MsgBox "Datei kann nicht geöffnet werden!", vbExclamation, ThisWorkbook.Name db.Close Set db = Nichts Exit Sub End If RS2WS rs, TargetCell rs.Close Set rs = Nichts db. Schließen Set db = Nichts End Sub Sub RS2WS(rs As DAO.Recordset, TargetCell As Range) Dim f As Integer, r As Long, c As Long Wenn rs nichts ist Dann Sub beenden Wenn TargetCell nichts ist Dann Sub mit Anwendung beenden .Berechnung = xlCalculationManual .ScreenUpdating = False .StatusBar = "Daten aus Recordset schreiben… " End With With TargetCell.Cells(1, 1) r = .Row c = .Column End With With With TargetCell.Parent .Range(.Cells(r, c ). r, c + f).Formel = rs.Fields(f).Name On Error GoTo 0 Next f ' write rec ords On Error Resume Next rs.MoveFirst On Error GoTo 0 Do While Not rs.EOF r = r + 1 For f = 0 To rs.Fields.Count - 1 On Error Resume Next .Cells(r, c + f).Formula = rs.Fields(f).Value On Error GoTo 0 Next f rs.MoveNext Loop .Rows(TargetCell.Cells(1, 1).Row).Font.Bold = True .Columns("A:IV").AutoFit End With With Application .StatusBar = False .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub
In den Makrobeispielen wird davon ausgegangen, dass Ihr VBA-Projekt einen Verweis auf die DAO-Objektbibliothek hinzugefügt hat.
Sie können dies innerhalb der VBE tun, indem Sie das Menü Extras, Verweise auswählen und Microsoft DAO x.xx-Objektbibliothek auswählen.
