Wykorzystanie SQL-a w Excelu bez jakiejkolwiek bazy danych

Ostatnio wpadłem na dosyć oryginalny pomysł (pewnie nie ja pierwszy) wykorzystania silnika JET do wykonywania operacji na danych wprost z Excel-a. Pomysł opiera się na tym że można wskazać dowolny plik Excel jako źródło danych dla kwerendy SQL. Główkując chwilę stworzyłem procedurę tworzącą obiekt QueryTable w wybranej lokalizacji która zwraca wynik zapytania SQL. Jak wiadomo QueryTable to taki fajny mechanizm do prezentacji danych zewnętrznych w postaci tabelki. Ma wiele gadżetów ale nie o tym dziś mowa. Kod procedury i przykładowe wykorzystanie poniżej.

Plik do pobrania

Sub Raport(Target As Range, SQL As String, Optional Name)

Dim sConn As String
Dim sPath As String
Dim sName As String
Dim qt As QueryTable
Dim wks As Excel.Worksheet

If IsMissing(Name) Then
' sprawdź czy taki obiekt nie istnieje
sName = "Lista"
Else
sName = CStr(Name)
End If

On Error Resume Next
If ThisWorkbook.Names(sName).Name <> "" Then
If Err.Number = 0 Then
sName = sName & "_1"
End If
Err.Clear
End If

On Error GoTo ERR_Handler:
' ścieżka do pliku roboczego
sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name

' Connection String
sConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;Data Source=" & sPath & ";" & _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";" & _
"Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;"

' skoroszyt roboczy
Set wks = Target.Parent

' sprawdź czy obiekt istnieje
If wks.QueryTables.Count > 0 Then
' generuje błąd jak QT nie ma, działanie celowe
Set qt = wks.QueryTables(sName)
Else
' generuj błąd braku obiektu
Err.Raise 9
End If

With qt   ' tworzymy obiekt QueryTable we wskazanej lokalizacji
.CommandType = xlCmdSql ' informacja o tym że korzystamy z polecenia SQL
.CommandText = SQL ' Komenda SQL, gdzie [Sheet1$] skoroszytem, po wstawieniu np. [lista] pobieramy dane z zakresu nazwanego
.Name = sName ' nazwa obiektu Querytable
.Refresh BackgroundQuery:=False 'pobieramy dane
End With

END_Handler:

Exit Sub

ERR_Handler:

Select Case Err.Number
Case 9
' tworzenie obiektu
Set qt = wks.QueryTables.Add(Connection:=sConn, Destination:=Target)
Resume Next

Case Else
MsgBox Err.Description
Resume END_Handler:
End Select

End Sub

' przykład wykorzystania
Sub test()
' wyswietl elementy ze skoroszytu Sheet1, znak $ konieczny do tego żeby JET wiedział że to cały skoroszyt
Raport Sheet3.Range("A1"), "select * from [Sheet1$]", "Wynik_2"
'policz oraz sumuj elementy z obszaru nazwanego lista
Raport Sheet3.Range("D1"), "select count(*) as ILE, sum(R) as [S] from [lista]", "Wynik_3"
End Sub