Frage: Per DAO Daten auslesen. Aus der Datei in welcher sich der Code befindet (also die gerade geöffnete Datei). Ergebnis sollen bestimmte Daten sein (berechnet und aufbereitet über SQL). In einem zweiten Schritt soll das gleiche mit einer geschlossenen Datei gemacht werden.
Read data via DAO. From the file in which the code is (the file you just opened). Result will be certain data (calculated and processed via SQL). In a second step, the same is to be made with a closed file.
Hier noch eine Beispieldatei / Here's a sample file:
DAO - DieseArbeitsmappe und externe Datei - Daten auslesen...[ZIP 30 KB]
Nachfolgend der Code für die externe geschlossene XLSX-Datei / Below is the code for the external closed xlsx file.
Read data via DAO. From the file in which the code is (the file you just opened). Result will be certain data (calculated and processed via SQL). In a second step, the same is to be made with a closed file.
Hier noch eine Beispieldatei / Here's a sample file:
DAO - DieseArbeitsmappe und externe Datei - Daten auslesen...[ZIP 30 KB]
OptionExplicit
'--------------------------------------------------------------------------
' Module : Module1
' Procedure : Main
' Author : Case (Ralf Stolzenburg)
' Date : 15.10.2013
' Purpose : DAO ThisWorkbook and external WorkBook...
'--------------------------------------------------------------------------
SubMain()
DimobjDatabaseAsObject
DimobjRecordAsObject
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
' Auf Sheet2 wird alles gelöscht
Sheet2.Cells.Clear
' Ab Excel 2007 nimm diese Engine und nimm
' DieseArbeitsmappe (ThisWorkbook) als Datenbasis
IfVal(Application.Version)>=12Then
SetobjDatabase=CreateObject("DAO.DBEngine.120").OpenDatabase_
(ThisWorkbook.FullName,False,False,"Excel 8.0")
' Vor Excel 2007 nimm diese Engine und nimm
' DieseArbeitsmappe (ThisWorkbook) als Datenbasis
Else
SetobjDatabase=CreateObject("DAO.DBEngine.36").OpenDatabase_
(ThisWorkbook.FullName,False,False,"Excel 8.0")
EndIf
' Fülle den Recordset basierend auf dem SQL-String
' Sheet1 kommt aus dem englischen Excel und muss gegebenenfalls
' ANGEPASST werden!
SetobjRecord=objDatabase.OpenRecordset("SELECT [Sheet1$].Name, "&_
"[Sheet1$].Group, "&_
"Sum([Sheet1$].Hint) AS Hint, "&_
"AVG([Sheet1$].Hint) AS Average"&_
" FROM [Sheet1$] GROUP BY [Sheet1$].Name, "&_
"[Sheet1$].Group ORDER BY [Sheet1$].Name, "&_
"[Sheet1$].Group;")
' Zeile 1 von Sheet1 nach Sheet2 kopieren
Sheet1.Range("A1").EntireRow.CopySheet2.Range("A1")
' Recordset auf einen Rutsch in Sheet2 eintragen
Sheet2.Range("A2").CopyFromRecordsetobjRecord
Fin:
' Wenn Recordset offen, dann schliessen
IfNotobjRecordIsNothingThenobjRecord.Close
' Setze die Objektvariable auf Nothing
SetobjRecord=Nothing
' Wenn Datentunnel offen, dann schliessen.
IfNotobjDatabaseIsNothingThenobjDatabase.Close
' Setze die Objektvariable auf Nothing
SetobjDatabase=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
Nachfolgend der Code für die externe geschlossene XLSX-Datei / Below is the code for the external closed xlsx file.
OptionExplicit
'--------------------------------------------------------------------------
' Module : Module2
' Procedure : Main_1
' Author : Case (Ralf Stolzenburg)
' Date : 15.10.2013
' Purpose : DAO ThisWorkbook and external WorkBook...
'--------------------------------------------------------------------------
SubMain_1()
DimstrFilenameAsString
DimobjDatabaseAsObject
DimobjRecordAsObject
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
strFilename=ThisWorkbook.Path&Application.PathSeparator&"DAO_SQL.xlsx"
' Auf Sheet3 wird alles gelöscht
Sheet3.Cells.Clear
' Ab Excel 2007 nimm diese Engine und nimm
' DieseArbeitsmappe (ThisWorkbook) als Datenbasis
IfVal(Application.Version)>=12Then
SetobjDatabase=CreateObject("DAO.DBEngine.120").OpenDatabase_
(strFilename,False,False,"Excel 8.0")
' Vor Excel 2007 nimm diese Engine und nimm
' DieseArbeitsmappe (ThisWorkbook) als Datenbasis
Else
SetobjDatabase=CreateObject("DAO.DBEngine.36").OpenDatabase_
(strFilename,False,False,"Excel 8.0")
EndIf
' Fülle den Recordset basierend auf dem SQL-String
' Sheet1 kommt aus dem englischen Excel und muss gegebenenfalls
' ANGEPASST werden!
SetobjRecord=objDatabase.OpenRecordset("SELECT [Sheet1$].Name, "&_
"[Sheet1$].Group, "&_
"Sum([Sheet1$].Hint) AS Hint, "&_
"AVG([Sheet1$].Hint) AS Average"&_
" FROM [Sheet1$] GROUP BY [Sheet1$].Name, "&_
"[Sheet1$].Group ORDER BY [Sheet1$].Name, "&_
"[Sheet1$].Group;")
' Zeile 1 von Sheet1 nach Sheet2 kopieren
Sheet1.Range("A1").EntireRow.CopySheet3.Range("A1")
' Recordset auf einen Rutsch in Sheet2 eintragen
Sheet3.Range("A2").CopyFromRecordsetobjRecord
Fin:
' Wenn Recordset offen, dann schliessen
IfNotobjRecordIsNothingThenobjRecord.Close
' Setze die Objektvariable auf Nothing
SetobjRecord=Nothing
' Wenn Datentunnel offen, dann schliessen.
IfNotobjDatabaseIsNothingThenobjDatabase.Close
' Setze die Objektvariable auf Nothing
SetobjDatabase=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