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.
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.
OptionExplicit
'-----------------------------------------------------------------------------
' 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
SubMain()
' Dimensionieren der Variablen
DimobjQueryDefAsObject
DimintCountAsInteger
DimobjDBankAsObject
DimobjRSetAsObject
DimlngCalcAsLong
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
OnErrorGoToFin
' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
WithApplication
' 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
EndWith
' Hier öffne ich die Beispieldatenbank "case_sample.accdb"
' bzw. "case_sample.mdb"
IfVal(Application.Version)>=12Then
' Pfad- und Dateiname gegebenenfalls anpassen
SetobjDBank=CreateObject("DAO.DBEngine.120").OpenDatabase_
(ThisWorkbook.Path&Application.PathSeparator&"case_sample.accdb")
Else
' Pfad- und Dateiname gegebenenfalls anpassen
SetobjDBank=CreateObject("DAO.DBEngine.36").OpenDatabase_
(ThisWorkbook.Path&Application.PathSeparator&"case_sample.mdb")
EndIf
' Der Objektvariablen wird die in Access vorhandene Abfrage "para1" zugewiesen
SetobjQueryDef=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
SetobjRSet=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
WithSheet1
' Spalte A - D löschen
.Columns("A:D").Clear
' Spaltenüberschriften bzw. Feldnamen eintragen
ForintCount=0ToobjRSet.Fields.Count-1
.Cells(1,intCount+1).Value=objRSet.Fields(intCount).Name
NextintCount
'Trage den Inhalt des Recordset ab A2 folgende ein
.Range("A2").CopyFromRecordsetobjRSet
' Ideale Breite der Spalten A - D
.Columns("A:D").AutoFit
' Überschrift Fett
.Range(.Cells(1,1),.Cells(1,4)).Font.Bold=True
EndWith
Fin:
' Schliesse die Datenbank
IfNotobjDBankIsNothingThenobjDBank.Close
' Setze die Objektvariablen auf Nothing
SetobjQueryDef=Nothing
SetobjRSet=Nothing
SetobjDBank=Nothing
' Die Applikation aufwecken
WithApplication
' 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
EndWith
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub