Frage: Aus einer Access Datenbank sollen Daten ausgelesen werden. Zum Beispiel Kundennummern ab einer bestimmten Zahl bis zu einer bestimmten Zahl. Eine bestehende Abfrage in Access kann genutzt werden.
In einem zweiten Schritt soll die gesamte Tabelle per SQL abgefragt werden.
Schließlich noch eine eigene Eingabe durch InputBoxen der jeweiligen Kundendaten.
From an Access database data should be read. For example, customer numbers from a given number up to a certain number.
An existing query in Access can be used.
In a second step, the entire table can be queried using SQL.
Finally, a special input through input boxes of the respective customer data.
Hier noch eine Beispieldatei / Here's a sample file:
DAO - Accessdatenbank - Daten auslesen...[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.
In einem zweiten Schritt soll die gesamte Tabelle per SQL abgefragt werden.
Schließlich noch eine eigene Eingabe durch InputBoxen der jeweiligen Kundendaten.
From an Access database data should be read. For example, customer numbers from a given number up to a certain number.
An existing query in Access can be used.
In a second step, the entire table can be queried using SQL.
Finally, a special input through input boxes of the respective customer data.
Hier noch eine Beispieldatei / Here's a sample file:
DAO - Accessdatenbank - Daten auslesen...[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 : 01.04.2013
' Purpose : DAO Accessdatenbank Abfrage 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
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
' Fülle die Objektvariable "objRSet" mit dem RecordSet
' erstellt aus der Auswahl-Abfrage "gk"
SetobjRSet=objDBank.OpenRecordset("gk")
' 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
' Alles löschen
.Cells.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
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
'-----------------------------------------------------------------------------
' Module : Module1
' Procedure : Main_1
' Author : Case (Ralf Stolzenburg)
' Date : 01.04.2013
' Purpose : DAO Accessdatenbank Daten in Excel ausgeben SQL...
'-----------------------------------------------------------------------------
' 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_1()
' Dimensionieren der Variablen
DimintCountAsInteger
DimobjDBankAsObject
DimobjRSetAsObject
DimstrSQLAsString
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
' SQL String erstellen
strSQL="SELECT customerdata.[customer number],"&_
"customerdata.name, customerdata.city, customerdata.Date "&_
"FROM customerdata "&_
"WHERE (((customerdata.[customer number])>=1000"&_
"And (customerdata.[customer number])<=4500));"
' Fülle die Objektvariable "objRSet" mit dem RecordSet
' erstellt aus der SQL-Anweisung
SetobjRSet=objDBank.OpenRecordset(strSQL)
' 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
' Alles löschen
.Cells.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
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
'-----------------------------------------------------------------------------
' Module : Module1
' Procedure : Main_2
' Author : Case (Ralf Stolzenburg)
' Date : 01.04.2013
' Purpose : DAO Accessdatenbank Daten in Excel (InputBox) ausgeben SQL...
'-----------------------------------------------------------------------------
' 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_2()
' Dimensionieren der Variablen
DimintCountAsInteger
DimobjDBankAsObject
DimvarTMP1AsVariant
DimobjRSetAsObject
DimvarTMPAsVariant
DimstrSQLAsString
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
' Abfrage der Werte - Eingabe muss zwischen 2 und 60.000 sein
varTMP=Application.InputBox(" 2 to 60000",_
"Input",1000,,,,,1)
IfvarTMP<>FalseThen
IfvarTMP>=2AndvarTMP<=60000Then
' Abfrage der Werte - Eingabe muss zwischen 2 und 60.000 sein
varTMP1=Application.InputBox(" 2 to 60000",_
"Input",4500,,,,,1)
IfvarTMP1<>FalseThen
IfvarTMP1>=2AndvarTMP<=60000Then
' 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
' SQL String erstellen
strSQL="SELECT customerdata.[customer number],"&_
"customerdata.name, customerdata.city, customerdata.Date "&_
"FROM customerdata "&_
"WHERE (((customerdata.[customer number])>="&varTMP&_
"And (customerdata.[customer number])<="&varTMP1&"));"
' Fülle die Objektvariable "objRSet" mit dem RecordSet
' erstellt aus der SQL-Anweisung
SetobjRSet=objDBank.OpenRecordset(strSQL)
' 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
' Alles löschen
.Cells.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
Else
MsgBox"Invalid!"
EndIf
Else
MsgBox"Aborted!"
EndIf
Else
MsgBox"Invalid!"
EndIf
Else
MsgBox"Aborted!"
EndIf
Fin:
' Schliesse die Datenbank
IfNotobjDBankIsNothingThenobjDBank.Close
' Setze die Objektvariablen auf 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