[Access VBA] Spalten einer Abfrage auslesen
Gepostet am: Jun 15, 2013 6:19:12 PM
Kürzlich war ich mit dem Export einer Access Tabelle nach Excel, bei der komplexe Berechnungen zusätzlich angefallen sind, betraut. Herausforderung hierbei war, dass die zu exportierenden Spalten neben den Berechnungen konfigurierbar sind. Mein Ansatz dabei war, dass neben den Ergebnissen der Berechnung die zusätzlichen Spalten über eine Abfrage konfigurierbar sind. Das bedeutet, nur die Spalten, die in der Abfrage ausgewählt sind, werden exportiert.
Ausgangslage
Ausgangslage ist eine einfache Tabelle ("Haupttabelle")
und eine Ansicht mit dem Namen "auszugebende_Spalten"
Ansatz 1: nur die Spalten festlegen
Benötigt man nur die Spaltennamen für den Export und keine Filterkriterien ist dieser Ansatz zu bevorzugen.
Ermitteln der Anzahl der Spalten
Für das grundsätzliche Verständnis möchte ich zeigen, welche 2 Methoden es hierfür gibt:
(a) mittels RecordSet
Methode 1
Public Function Columns_Count(strTable As String) As Integer Dim db As DAO.Database Dim rs As DAO.Recordset Dim iFieldCount As Integer Set db = CurrentDb Set rs = db.OpenRecordset("Select * from " & strTable, dbOpenSnapshot) iFieldCount = rs.Fields.Count Columns_Count = iFieldCount rs.Close db.CloseEnd Function
(b) mitteld TableDefs/QueryDefs
Da nicht von vornherein klar ist, ob der Übergabeparameter eine Tabelle oder eine Abfrage ist, muss dies unterschieden werden
Methode 2
Public Function Columns_Count2(strTable As String) As Integer Dim db As DAO.Database Set db = CurrentDb 'falls es eine Tabelle ist Dim tdf As DAO.TableDef For Each tdf In db.TableDefs If tdf.Name = strTable Then Columns_Count2 = db.TableDefs(strTable).Fields.Count db.Close Exit Function End If Next 'falls es eine Abfrage ist Dim qdf As DAO.QueryDef For Each qdf In db.QueryDefs If qdf.Name = strTable Then Columns_Count2 = db.QueryDefs(strTable).Fields.Count db.Close Exit Function End If NextEnd Function
Ermitteln der Spaltennamen
Die selben Methoden kann man auch bei der Ermittlung der Spaltennamen verwenden:
Methode 1
Public Function Read_Columns(strTable As String) As Collection Dim db As DAO.Database Dim rs As DAO.Recordset Dim Field As DAO.Field Dim myColl As Collection Set myColl = New Collection Dim i As Integer Dim strFieldName As String Set db = CurrentDb Set rs = db.OpenRecordset("Select * from " & strTable, dbOpenSnapshot) For Each Field In rs.Fields myColl.Add (Field.Name) Next rs.Close db.Close Set rs = Nothing Set db = Nothing Set Read_Columns = myColl Set myColl = Nothing End Function
bzw.
Methode 2
Public Function Read_Columns2(strTable As String) As Collection Dim db As DAO.Database Set db = CurrentDb Dim myColl As Collection Set myColl = New Collection Dim Field As DAO.Field 'falls es eine Tabelle ist Dim tdf As DAO.TableDef For Each tdf In db.TableDefs If tdf.Name = strTable Then For Each Field In db.TableDefs(strTable).Fields myColl.Add (Field.Name) Next db.Close Set db = Nothing Set Read_Columns2 = myColl Set myColl = Nothing Exit Function End If Next 'falls es eine Abfrage ist Dim qdf As DAO.QueryDef For Each qdf In db.QueryDefs If qdf.Name = strTable Then For Each Field In db.QueryDefs(strTable).Fields myColl.Add (Field.Name) Next db.Close Set db = Nothing Set Read_Columns2 = myColl Set myColl = Nothing Exit Function End If NextEnd Function
v
Das Problem hierbei ist, dass bei der Abfrage die ID Spalte nicht ausgegeben wird, da diese nicht Bestandteil des der Select Abfrage ist. Das lässt sich auch nicht ändern, was damit begründet ist, dass dies auch keine Spalte iS von SQL ist:
SQL-Abfrage
SELECT Haupttabelle.[Spalte 1], Haupttabelle.[Spalte 2], Haupttabelle.[Spalte 3]FROM Haupttabelle ORDER BY Haupttabelle.ID;
Export2Excel
Da im konkreten Fall jedoch nur die Spalten ermittelt werden und nicht etwaige Sortier- und Filterkriterien übernommen werden, würde es keinen Sinn machen diese in der Ansicht zu verwenden. Im konkreten Fall würde das folgendermaßen aussehen:
Export2Excel
Public Sub sExport2Excel1() '(1) Ermitteln der auszugebenden Spalten Dim myColumns As Collection Dim myColumn As Variant Set myColumns = Read_Columns("auszugebende_Spalten") '(2) Erstellen einer Excel Datei 'erfordert einen Verweis auf Excel! Dim appExcel As Excel.Application Set appExcel = New Excel.Application Dim wkbExcel As Excel.Workbook Set wkbExcel = appExcel.Workbooks.Add Dim wksExcel As Excel.Worksheet Set wksExcel = wkbExcel.Worksheets(1) appExcel.Visible = False '(3) Spaltenüberschriften erstellen Dim icounter As Integer icounter = 1 For Each myColumn In myColumns wksExcel.Cells(1, icounter) = CStr(myColumn) icounter = icounter + 1 Next 'zusätzliche Spalte für das Ergebnis der Berechnung wksExcel.Cells(1, icounter) = "Berechnung" '(3) Auslesen des Recordsets & Übertragung ins Excel Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Select * from Haupttabelle", dbOpenSnapshot) If rs.EOF Then Exit Sub Dim iRow As Integer Dim iColums As Integer iRow = 2 'da in der ersten Spalte die Überschriften stehen With rs Do Until .EOF iColumn = 1 For Each myColumn In myColumns wksExcel.Cells(iRow, iColumn) = (.Fields(CStr(myColumn))) iColumn = iColumn + 1 Next 'Berechnungen '************** wksExcel.Cells(iRow, iColumn) = CDbl(.Fields("Zahl 1").Value) + CDbl(.Fields("Zahl 2").Value) + CDbl(.Fields("Zahl 3").Value) .MoveNext iRow = iRow + 1 Loop End With rs.Close db.Close Set rs = Nothing Set db = Nothing '(4) Excel anzeigen appExcel.Visible = TrueEnd Sub
Ansatz 2: Ansicht um die für die Berechnung benötigten Spalten erweitern
Ansicht programmatisch um Spalten erweitern
Mit folgender Funktion kann man eine bestehende Abfrage um die in der Collection gespeicherten Felder (Fields) einer bestimmten Ausgangstabelle (strQuellTabelle) erweitern:
Abfrage erweitern
Public Function AddFields2Query(strQuery As String, strQuellTabelle As String, Fields As Collection) As String'gibt einen SQL String zurück, der einerseits aus einer bestehenden Abfrage und zusätzlichen Feldern besteht'kann in weiterer Folge für eine temporäre Abfrage verwendet werdenDim db As DAO.Database Dim qry As DAO.QueryDef Set db = CurrentDb Set qry = db.QueryDefs(strQuery)'Abfrage erweiternDim mynewField As VariantDim AddSQL As String AddSQL = ", "For Each mynewField In Fields '(1) überprüfen, ob das Feld schon in der Ansicht existiert 'und die Erweiterung des SQL-Befehls zusammenbauen Dim currField As DAO.Field Dim bInQuery As Boolean bInQuery = False For Each currField In qry.Fields If CStr(currField.Name) = CStr(mynewField) Then bInQuery = True Exit For End If Next 'wenn das Feld nicht in der Tabelle existiert If bInQuery = False Then AddSQL = AddSQL & strQuellTabelle & ".[" & mynewField & "], " End IfNext 'AddSQL um den letzten ", " bereinigen AddSQL = Left(AddSQL, Len(AddSQL) - 2) Dim oldSQL As String oldSQL = qry.SQL Dim ArrSQL As Variant ArrSQL = Split(oldSQL, "FROM") AddFields2Query = ArrSQL(0) & AddSQL & " FROM " & LTrim(ArrSQL(1))End Function
Rückgabewert ist ein String, den man beispielsweise für eine temporäre Abfrage verwenden kann.
Export2Excel
Nachfolgend ein Beispiel, wie man das ganze aussehen könnte:
Export2Excel
Public Sub sExport2Excel2() '(1) Ermitteln der Spalten, die ausgegeben werden sollen Dim myColumns As Collection Dim myColumn As Variant Set myColumns = Read_Columns("auszugebende_Spalten") '(2) Erstellen einer Excel Datei 'erfordert einen Verweis auf Excel! Dim appExcel As Excel.Application Set appExcel = New Excel.Application Dim wkbExcel As Excel.Workbook Set wkbExcel = appExcel.Workbooks.Add Dim wksExcel As Excel.Worksheet Set wksExcel = wkbExcel.Worksheets(1) appExcel.Visible = False '(3) Spaltenüberschriften erstellen Dim icounter As Integer icounter = 1 For Each myColumn In myColumns wksExcel.Cells(1, icounter) = CStr(myColumn) icounter = icounter + 1 Next 'zusätzliche Spalte für das Ergebnis der Berechnung wksExcel.Cells(1, icounter) = "Berechnung" '(4) Lege die Felder fest, die für die Berechnung benötigt werden Dim myColl As Collection Set myColl = New Collection myColl.Add ("Zahl 1") myColl.Add ("Zahl 2") myColl.Add ("Zahl 3") '(5) ermittle die erweiterte Abfrage Dim tmpSQL As String tmpSQL = AddFields2Query("auszugebende_Spalten", "Haupttabelle", myColl) '(6) Datenbank abfragen Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset(tmpSQL, dbOpenSnapshot) If rs.EOF Then Exit Sub Dim iRow As Integer Dim iColums As Integer iRow = 2 'da in der ersten Spalte die Überschriften stehen With rs Do Until .EOF iColumn = 1 For Each myColumn In myColumns wksExcel.Cells(iRow, iColumn) = (.Fields(CStr(myColumn))) iColumn = iColumn + 1 Next 'Berechnungen '************** wksExcel.Cells(iRow, iColumn) = CDbl(.Fields("Zahl 1").Value) + CDbl(.Fields("Zahl 2").Value) + CDbl(.Fields("Zahl 3").Value) .MoveNext iRow = iRow + 1 Loop End With rs.Close db.Close Set rs = Nothing Set db = Nothing '(7) Excel anzeigen appExcel.Visible = True End Sub