User Tools

Site Tools


vba:excel:adodbsql

[Excel][VBA][SQL] SQL in Excel einsetzen

Datenverarbeitung in Excel mittels SQL.

Version 1.6.0 - 22.01.2018

Download lib_adodb_for_xls.bas (V-1.6.0)

Excel ist nett, aber auch unübersichtlich. Vor allem wenn man mit Datenmengen und VBA arbeiten will. Um Daten anzureichern, in grösseren Mengen zu verarbeiten etc. sehe ich immer wieder Script die Zellenadressen zusammensetzen und dadurch unlesbar sind. Wer weiss beim lesen schon, was die A4 ist?

Nungut, ich komme von der Datenbankseite. Dort arbeite ich mit SQL um die Datan abzufragen, zusammenzusetzen etc.. Zum Glück für mich, ist das alles auch in Excel VBA möglich.

ADODB hiesst das Losungswort.
Ich erkläre hier nicht alle Details. Das WWW gibt gut auskunft. Nein, ich zeige wie ich es anwende

Den Code zu den Funktionen gibts am Schluss

Definitionen

axConnParams

Sammlung von steuerparametern. Es werden, ev. in Zukunft noch mehr.

Public Enum axConnParams
    axcNone = 0
    axcReconnect = 2 ^ 0    'Ein Reconnect wird erzwungen
    axcNoHeader = 2 ^ 1     'Die erste Zeile ist keine Kopfzeile. Die Felder werden mit f1, f2...fx angesprochen
End Enum

axWriteParams

Paramters zum Schreiben der Daten

'/**
Public Enum axWriteParams
    axwNone = 2 ^ 0             'Keine umwandlung
    axwHeaderRedable = 2 ^ 1    'Titel mit Unterlinien werden aufgetrennt "HAUS_NUMMER" -> "Haus Nummer"
End Enum

Initialisieren

Property connection

Als erstes habe ich mir ein Property geschrieben, das eine ADODB-Connection auf das aktuelle Workbook zurückgibt. Da ich mich später nicht darum kümmern will, ob ich die Connection schon geöffnet habe, ist es nach dem Tutorial Funktion mit Cache als Property umgesetzt.

'/**
' * Handle dhe adodb-connection to the current workbook
' * @param  axConnParams    Paramters für die Connection
' * @param  String          Pfad zur QuellDatei. Standard ist der Pfad des ausführenden Workbooks
' * @return ADODB.Conection
' */
Private Property Get connection(Optional ByVal iConnParams As axConnParams = axcNone, Optional ByVal iFilePath As String = Empty) As Object

Function openRs()

Der Nächste Schritt ist das Öffnen eines ADODB.Recordsets aus dem aktuellen Worksheet. Dazu brauchen wir natürlich die oben erwähnte Connection

'/**
' * Open a adodb recordset from the current workbook
' * @param  String          SQL-String
' * @param  axConnParams    Paramters für die Connection
' * @return ADODB.Recordset
' */
Public Function openRs(ByVal iSql As String, Optional ByVal iConnParams As axConnParams = axcNone) As Object

Function writeHeader()

Schreibt den Header in eine Zeile

'/**
' * Write the Header of a adodb.recordset
' * @param  Worksheet/Range/Address
' * @param  Recordset
' * @param  axWriteParams
' */
Public Sub writeHeader(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone)

Function writeFullData()

Mit dem einfachen Worksheet.CopyFromRecordset() werden nur die Daten geschrieben. Die folgende Funktion schreibt mittels writeHeader() zuerst die Kopfzeile und dann die Daten

'/**
' * Schreibt ins Excel inkl Header
' * @param  Worksheet/Range/Address
' * @param  Recordset
' * @param  axWriteParams
' */
Public Sub writeFullData(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone)

Anwenden von openRs()

Doch wie greift man mittels SQL jetzt auf die Daten zu? Es gibt mehrere Varianten um die Daten jetzt als Source in einem SQL anzusprechen

Quellen

Ganzes Worksheet als Tabelle

Häufig habe ich von Exports aus anderen Systemen gleich ein Worksheet, das genau einer Tabelle entspricht. Die erste Zeile hat die Titel, die folgenden Zeilen sind die Daten. Ich kann mit dem SQL gleich auf diese Daten zugriefen. Die Titel sind dann auch im SQL die Namen der Spalten.

Als Tabellennamen wird einfach der Sheet-Name gefolgt von einem $ verwendet.

-- Auflistung der Vornamen aus dem Sheet 'adress_sheet'
SELECT DISTINCT
    [firstname]
FROM
    [adress_sheet$]

Benannter Range als Tablle

Ich arbeite gerne mit benannten Ranges. so lassens ich sehr einfach Datenbereiche aus einem Sheet auslesen. Dazu einfach in einem Excelsheet einen Range selektionieren und bennen (Dazugibts diverse anleitungen im Web. zB. How to Define a Named Range in Excel). Am besten wählt man ein Bereich mit einer Titelzeile.

Für kleinere Mapping-Tabellen, Stammdaten etc. verwende ich jeweils nur ein Sheet und arbeite dann mit Benannten Ranges.

Da der Benannte Range für das ganze Workbook gültigkeit hat, muss auch kein Sheet angegeben werdn

Im SQL kann dann einfach gleich dieser Name als Quelle verwendet werden.

-- Zugriff auf den Range 'cities', der mitten in einem Sheet ist
SELECT 
    [plz],
    [city]
FROM
    [cities]

Beliebiger Range

Man kann auch auf einen beliebigen Bereich auf einem Sheet zugreifen. Ich rate jedoch davon ab. Adressen Hardcodiert - Never.

sheetName$adress

SELECT *
FROM [my_mappings$A3:G17]

Zusammenfassung der Sourcen

  • Ganzes Sheet: [sheetName$]
  • Benannter Range: [rangeName]
  • Beliebiger Range: [sheetName$adress]

Zugriff auf die Felder

Je nachdem, ob Feldernamen gefunden wurden oder nicht, kann Direkt auf den Feldnamen oder auf die Feldnummer zugegriffen werden.

  • Feld Name: [feldName]
  • Feld-Nr: F#

Beispiel

Ich lese die Daten aus dem Sheet ADDRESS und schreibe eine sie in das Sheet TARGET

Meine Library braucht zwar keine Referenz. Im Beispiel habe ich jedoch den Recordset mit Early Binding gemacht und muss darum eine Referenz auf Microsoft ActiveX Data Objects 6.1 Library setzen. Ansonsten den rs als Object definieren
Public Sub sqlTest()
    Dim rs As ADODB.Recordset
    Dim ws As Worksheet
 
    Set rs = openRs("SELECT [id], [vorname] & ' ' & [nachname] AS [name] " &_
                    "FROM [address$] " & _
                    "WHERE id BETWEEN 2 AND 3")
 
    Set ws = ActiveWorkbook.Sheets("TARGET")
    writeFullData ws.Range("A1"), rs
 
    rs.Close
End Sub

Handhabung der Header

Bei writeFullData() und beim writeHeader() kann man den Paramter iWriteParams auf axwHeaderRedable setzen. Ich zeige hier mal schnell noch den Unterschied. Die Tabelle Hat die 2 Felder

ID | SECURITY_TPE | SECURITY_ID
-------------------------------
 1 | T3           | AX3456Z
 2 | T3           | AX4564R

Mit dem Standard: iWriteParams = axwNone Die Titelzeile belibt unverändert

writeFullData Sheets("trg").Range("A1"), openRs("select * from [src$]")
ID | SECURITY_TPE | SECURITY_ID
-------------------------------
 1 | T3           | AX3456Z
 2 | T3           | AX4564R

Mit axwHeaderRedable wird die Titelzeile in eine lesbarere Form gebracht

writeFullData Sheets("trg").Range("A1"), openRs("select * from [src$]"), axwHeaderRedable
Id | Security Tpe | Security Id
-------------------------------
 1 | T3           | AX3456Z
 2 | T3           | AX4564R

Code

Und hier noch der Code zu den oben bechriebenen Funktionen

lib_adodb_for_xls.bas
Attribute VB_Name = "lib_adodb_for_xls"
'-------------------------------------------------------------------------------
'File         : lib_adodb_for_xls.bas
'               http://http://wiki.yaslaw.info/dokuwiki/doku.php/vba/excel/adodbsql
'Environment  : VBA 2010 +
'Version      : 1.6.0
'Name         : lib_adodb_for_xls
'Author       : Stefan Erb (ERS)
'History      : 27.01.2016 - ERS - Creation
'               07.08.2017 - ERS - Bei der Connection den optionalen Parameter filePath hinzugefügt. Header Konvertierung hinzugefügt, ZielRange kann jetzt auch ein Worksheet oder eine Adresse sein
'               25.09.2017 - ERS - openRs um den optionalen Wert Connection erweiter.
'               22.01.2018 - ERS - 64Bit Version hinzugefügt
'-------------------------------------------------------------------------------
Option Explicit
 
'-------------------------------------------------------------------------------
' -- Settings
'-------------------------------------------------------------------------------
'https://www.connectionstrings.com/ace-oledb-12-0/
Const C_CONN_STR = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='{#FILEPATH}'; Extended Properties='Excel 12.0;HDR={#HDR};IMEX=1'"
 
'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
 
'/**
' * Paramters zur Connection
' */
Public Enum axConnParams
    axcNone = 0
    axcReconnect = 2 ^ 0    'Ein Reconnect wird erzwungen
    axcNoHeader = 2 ^ 1     'Die erste Zeile ist keine Kopfzeile. Die Felder werden mit f1, f2...fx angesprochen
End Enum
 
'/**
' * Paramters zum Schreiben der Daten
' */
Public Enum axWriteParams
    axwNone = 2 ^ 0             'Keine umwandlung
    axwHeaderRedable = 2 ^ 1    'Titel mit Unterlinien werden aufgetrennt "HAUS_NUMMER" -> "Haus Nummer"
End Enum
 
 
'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
 
'/**
' * Die Parameter für das ADODB Objekt
' * https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/open-method-ado-recordset
' */
Private Enum lateBindingAdodbParameters
    adDate = 7
    adDouble = 5
    adStateOpen = 1
    adCmdText = 1
    adUseClient = 3
    adOpenDynamic = 2
    adOpenStatic = 3
    adLockOptimistic = 3
    adLockReadOnly = 1
End Enum
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Open a adodb recordset from the current workbook
' * @param  String          SQL-String
' * @param  axConnParams    Paramters für die Connection
' * @return ADODB.Recordset
' */
Public Function openRs(ByVal iSql As String, Optional ByVal iConnParams As axConnParams = axcNone, Optional ByRef iConnection As Object = Nothing) As Object
    Dim rsT As Object: Set rsT = CreateObject("ADODB.Recordset")
    Dim cmd As Object: Set cmd = CreateObject("ADODB.Command")
 
    If iConnection Is Nothing Then
        Set cmd.ActiveConnection = connection(Abs(iConnParams)) 'Der abs() ist false jemand von Früher false übergibt.
    Else
        Set cmd.ActiveConnection = iConnection
    End If
    cmd.CommandType = adCmdText
    cmd.CommandText = iSql
 
    rsT.CursorLocation = adUseClient
    rsT.CursorType = adOpenStatic
    rsT.LockType = adLockReadOnly
 
    'open the recordset
    rsT.Open cmd
 
    'disconnect the recordset
    Set rsT.ActiveConnection = Nothing
 
    'cleanup
    If cmd.State = adStateOpen Then
        Set cmd = Nothing
    End If
    Set openRs = rsT
End Function
 
'/**
' * Schreibt ins Excel inkl Header
' * @param  Range   First cell
' * @param  Recordset
' */
Public Sub writeFullData(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone)
    Dim trg As range:   Set trg = castRange(iRange)
    writeHeader trg, ioRs, iWriteParams
    writeData trg.Offset(1), ioRs
End Sub
 
'/**
' * Write the Header of a adodb.recordset
' * @param  Range   First cell
' * @param  Recordset
' */
Public Sub writeHeader(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone)
    Dim trg As range:   Set trg = castRange(iRange)
    Dim colNr As Long
    Dim delta As Long:  delta = trg.Column
    trg.ClearContents
    For colNr = 0 To ioRs.fields.count - 1
        Dim txt As String: txt = ioRs.fields(colNr).name
        If Not andB(iWriteParams, axwNone) Then txt = strConv(Join(Split(txt, "_"), " "), vbProperCase)
        trg.Worksheet.Cells(iRange.row, colNr + delta).Value = txt
    Next
End Sub
 
'/**
' * Schreibt die Daten
' * @param  Range
' * @param  Recordset
' */
Public Sub writeData(ByRef iRange As Variant, ByRef iRs As Object)
    Dim trg As range:   Set trg = castRange(iRange)
    trg.ClearContents
    trg.CopyFromRecordset iRs
End Sub
 
'-------------------------------------------------------------------------------
' -- Private Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Parst Sheet und String in ein Range
' * @param  Worksheet/Range/Address
' * @return Range
' */
Private Function castRange(ByRef iVar As Variant) As range
    Select Case TypeName(iVar)
        Case "Worksheet":       Set castRange = iVar.UsedRange
        Case "Range":           Set castRange = iVar
        Case "String":          Set castRange = ActiveSheet.range(iVar)
    End Select
End Function
 
'/**
' * Handle dhe adodb-connection to the current workbook
' * @param  axConnParams    Paramters für die Connection
' * @return ADODB.Conection
' */
Private Property Get connection(Optional ByVal iConnParams As axConnParams = axcNone) As Object
    Static pConn As Object
    Static pParams As axConnParams
    If pConn Is Nothing Or andB(iConnParams, axcReconnect) Or pParams <> iConnParams Then
        pParams = iConnParams
        Set pConn = CreateObject("ADODB.Connection")
#If Win64 Then
        pConn.provider = "Microsoft.ACE.OLEDB.12.0"
#Else
        pConn.provider = "Microsoft.Jet.OLEDB.4.0"
#End If
        pConn.connectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 12.0 Xml;HDR=" & IIf(andB(iConnParams, axcNoHeader), "No", "Yes") & ";IMEX=1'"
    End If
    If Not (pConn.State And adStateOpen) = adStateOpen Then
         pConn.Open
    End If
    Set connection = pConn
End Property
 
'-------------------------------------------------------------------------------
' -- Libraries
'-------------------------------------------------------------------------------
 
'/**
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/andb
' * Macht einen Bit-Vergleich
' * @param  Long
' * @param  Long
' * @return Boolean
' */
Private Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean
    andB = ((iHaystack And iNeedle) = iNeedle)
End Function
 
vba/excel/adodbsql.txt · Last modified: 06.05.2019 11:08:01 by yaslaw