DAO - Parameterabfrage in Access aus Excel ausführen und auswerten...

Frage: Mit Excel VBA eine Parameterabfrage in Access starten und auswerten. Die Parameterwerte stehen im Tabellenblatt (z. B. K1 und K2). Wie geht das?

Starting with Excel VBA a parameter query in Access and evaluate. The parameter values ​​are in the spreadsheet (eg, K1 and K2). How does it work?

Hier noch eine Beispieldatei / Here's a sample file:
DAO - Parameterabfrage in Access aus Excel ausführen und auswerten...[ZIP 2.2 MB]

In der Beispieldatei sind die Access Datenbank in zwei Versionen (accdb und mdb), die Exceldatei mit dem Code in drei Versionen (xls, xlsm und xlsb) und die Exceldatei mit den Grunddaten.

In the sample file, the Access database in two versions (mdb and accdb), the Excel file with the code in three versions (xls, xlsm and xlsb) and the Excel file containing the basic data.

Option Explicit
'-----------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 02.04.2013
' Purpose   : DAO Accessdatenbank Parameterabfrage in Excel ausgeben...
'-----------------------------------------------------------------------------
' Getestet in Excel 2007/2010/2013 - Access muss NICHT installiert sein
' http://msdn.microsoft.com/de-de/library/office/ff965871%28v=office.14%29.aspx
Sub Main()
    ' Dimensionieren der Variablen
    Dim objQueryDef As Object
    Dim intCount As Integer
    Dim objDBank As Object
    Dim objRSet As Object
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        ' Das Bildschirmaktualisierung wird unterbrochen
        .ScreenUpdating = False
        ' Ereignisroutinen werden deaktiviert
        .EnableEvents = False
        ' Auslesen der momentanen Einstellung für die Berechnung
        lngCalc = .Calculation
        ' Setzen der Berechnung auf "Manuell"
        .Calculation = xlCalculationManual
        '  Eingabeaufforderungen und Warnmeldungen unterdrücken
        .DisplayAlerts = False
    End With
    ' Hier öffne ich die Beispieldatenbank "case_sample.accdb"
    ' bzw. "case_sample.mdb"
    If Val(Application.Version) >= 12 Then
        ' Pfad- und Dateiname gegebenenfalls anpassen
        Set objDBank = CreateObject("DAO.DBEngine.120").OpenDatabase _
            (ThisWorkbook.Path & Application.PathSeparator & "case_sample.accdb")
    Else
        ' Pfad- und Dateiname gegebenenfalls anpassen
        Set objDBank = CreateObject("DAO.DBEngine.36").OpenDatabase _
            (ThisWorkbook.Path & Application.PathSeparator & "case_sample.mdb")
    End If
    ' Der Objektvariablen wird die in Access vorhandene Abfrage "para1" zugewiesen
    Set objQueryDef = objDBank.QueryDefs("para1")
    ' Die Parameter werden mit Werten - hier aus K1 und 2 - gefüllt
    objQueryDef.Parameters("From customer data:") = Sheet1.Range("K1").Value
    objQueryDef.Parameters("To customer data:") = Sheet1.Range("K2").Value
    ' Fülle die Objektvariable "objRSet" mit dem RecordSet bzw. den
    ' Daten aus der resultierenden Parameterabfrage
    Set objRSet = objQueryDef.OpenRecordset()
    ' Der Code bezieht sich auf ein bestimmtes Objekt
    ' Hier Sheet1 = der CodeName der Tabelle
    ' im deutschen Excel in der Regel Tabelle1
    ' Alles was sich auf dieses "With" bezieht
    ' MUSS mit einem Punkt beginnen
    With Sheet1
        ' Spalte A - D löschen
        .Columns("A:D").Clear
        ' Spaltenüberschriften bzw. Feldnamen eintragen
        For intCount = 0 To objRSet.Fields.Count - 1
            .Cells(1, intCount + 1).Value = objRSet.Fields(intCount).Name
        Next intCount
        'Trage den Inhalt des Recordset ab A2 folgende ein
        .Range("A2").CopyFromRecordset objRSet
        ' Ideale Breite der Spalten A - D
        .Columns("A:D").AutoFit
        ' Überschrift Fett
        .Range(.Cells(1, 1), .Cells(1, 4)).Font.Bold = True
    End With
Fin:
    ' Schliesse die Datenbank
    If Not objDBank Is Nothing Then objDBank.Close
    ' Setze die Objektvariablen auf Nothing
    Set objQueryDef = Nothing
    Set objRSet = Nothing
    Set objDBank = Nothing
    ' Die Applikation aufwecken
    With Application
        ' Bildschirmaktualisierung wieder einschalten
        .ScreenUpdating = True
        ' Ereignisroutinen werden wieder aktiviert
        .EnableEvents = True
        ' Setzen der Berechnung auf den gemerkten Wert
        .Calculation = lngCalc
        ' Eingabeaufforderungen und Warnmeldungen wieder zulassen
        .DisplayAlerts = True
        ' Abbrechen Ausschneide- bzw. Kopiermodus und entfernen des Laufrahmens
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...