QueryTables i zewnętrzne Recordsety

Ciekawą właściwością obiektu QueryTables (powstaje gdy pobieramy dane zewnętrzne) jest możliwość wpompowania recordsetu ADO. Dzięki temu w łatwy i przyjemny sposób jesteśmy wstanie przygotować sobie uniwersalną maszynę generującą jakiś raport a następnie umieszczającą w przygotowanym szablonie. poniżej przedstawiam przykładowy kod (kod ze skoroszytu, nie można go umieścić bezpośrednio w module) realizujący tego typu operację. Omówienia wymaga tylko linia

Me.QueryTables(1)

wskazuje ona na pierwszą definicję obiektu QueryTables w skoroszycie w którym wykonywany jest kod. na upartego kod możemy umieścić gdzie indziej i wywołać po zmianie linii

Arkusz1.QueryTables(1)

Deklaracja

Private WithEvents

sprawia że obiekty w taki sposób zadeklarowane udostępniają nam obsługę eventów - przydatne, na końu przedstawiłem prosty przykład wykorzystania

I jeszcze jedna ważna uwaga: po wpompowaniu danych do takiego obiektu tracimy definicje w nim zawarte czyli nie będziemy mogli go odświeżyć za pomocą polecenia odśwież (obecny pod prawoklikiem)

Option Explicit

Private WithEvents aConn As ADODB.Connection
Private WithEvents aRs As ADODB.Recordset

Sub wpopmpuj()

Dim sConn As String
Dim sql As String

On Error GoTo ERR_Handler:

' definicja połączenia
sConn = "Provider=SQLOLEDB.1;" & _
"Data Source=PRZEMEK-PC\SQLEXPRESS;" & _
"Integrated Security=SSPI;" & _
"Persist Security Info=True;" & _
"Initial Catalog=Aplikacja;" & _
"Use Procedure for Prepare=1;" & _
"Auto Translate=True;" & _
"Packet Size=4096;" & _
"Workstation ID=PRZEMEK-PC;" & _
"Use Encryption for Data=False;" & _
"Tag with column collation when possible=False"

' zapytanie SQL
sql = "select * from dbo.Employees"

' stworzenie obiektu
Set aConn = New ADODB.Connection

With aConn
.ConnectionString = sConn
.Open ' otwarcie połączenia
' pobranie danych do Recordset-u
Set aRs = .Execute(sql)
End With

' wypełnienie obiektu w Excelu
With Me.QueryTables(1)
Set .Recordset = aRs ' wpompowanie
.Refresh ' odswierzenie
End With

END_Handler:

' zamknięcie połązenia
aConn.Close
Set aConn = Nothing

Exit Sub

ERR_Handler:

' tu można przechwycić błędy

Resume END_Handler:

End Sub

' Akcja po wykonaniu execute
Private Sub aConn_ExecuteComplete(ByVal RecordsAffected As Long, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, _
ByVal pConnection As ADODB.Connection)

If Not IsNothing(pError) Then
Debug.Print pError.Description, pError.Source
End If

End Sub

' Akcja przed wykonaniem Execute
Private Sub aConn_WillExecute(Source As String, CursorType As ADODB.CursorTypeEnum, _
LockType As ADODB.LockTypeEnum, Options As Long, adStatus As ADODB.EventStatusEnum, _
ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, _
ByVal pConnection As ADODB.Connection)

Debug.Print Source
End Sub

' funkcja sprawdzająca istnienie obiektu
Private Function IsNothing(x)
IsNothing = TypeName(x) = "Nothing"
End Function

Ciekawy artykuł o kodowaniu

Dziś szukając informacji na temat kodowania tekstu w MS SQL serwerze natknąłem się na bardzo ciekawy wpis na blogu dotyczący właśnie tej kwestii.
W sposób łatwy i przystępny wyjasnia w jaki sposób użyć funkcji: EncryptByPassPhrase i DecryptByPassphrase.
http://www.pluralsight.com/community/blogs/dan/archive/2006/04/09/21375.aspx

Przedstawione przykłady przetestowałem na MS SQL 2005 Expres Edition.

Formater SQL

Dziś znalazłem świetne narzędzie wspomagające pracę:
http://www.dpriver.com/pp/sqlformat.htm
To fomater SQL-a (różne dialekty) z możliwością konstruowania kodu dla
rożnych języków programowania.
Przykład działania poniżej:

SELECT DISTINCT o.offerID as offerID_OR_categoryID,0 as searchType,'offer'
as attributeID,'porady' as word FROM Offers o LEFT JOIN OfferTagAssign ota
ON ota.offerID = o.offerID LEFT JOIN Tags t ON t.tagID = ota.tagID LEFT
JOIN OfferPromoTypeAssign opta ON opta.offerID = o.offerID WHERE
o.beginDatetimeNOW() AND ((o.label LIKE 'porady' OR o.label LIKE 'porady %'
OR o.label LIKE '% porady %' OR o.label LIKE '% porady') OR (t.tag LIKE
'porady' OR t.tag LIKE 'porady %' OR t.tag LIKE '% porady %' OR t.tag LIKE
'% porady') OR (o.offeror LIKE 'porady' OR o.offeror LIKE 'porady %' OR
o.offeror LIKE '% porady %' OR o.offeror LIKE '% porady')) UNION SELECT
o.offerID,1,a.attributeID,'
porady' FROM Offers o LEFT JOIN OfferAttr oa ON
oa.offerID = o.offerID LEFT JOIN Attributes a ON a.attributeID =
oa.attributeID LEFT JOIN AttributeTagAssign ota ON ota.attributeID =
a.attributeID LEFT JOIN Tags t ON t.tagID = ota.tagID LEFT JOIN
OfferPromoTypeAssign opta ON opta.offerID = o.offerID WHERE
o.beginDatetimeNOW() AND ((oa.valueText LIKE 'porady') OR (oa.valueFloat
LIKE 'porady') OR (oa.valueDate LIKE 'porady') OR (oa.valueTime LIKE
'porady') OR (oa.valueInt LIKE 'porady')) 

Po przepuszczeniu zaś wygląda tak:

SELECT DISTINCT o.offerid AS offerid_or_categoryid,
0         AS searchtype,
'offer'   AS attributeid,
'porady'  AS word
FROM   offers o
LEFT JOIN offertagassign ota
ON ota.offerid = o.offerid
LEFT JOIN tags t
ON t.tagid = ota.tagid
LEFT JOIN offerpromotypeassign opta
ON opta.offerid = o.offerid
WHERE  o.Begindatetimenow()
AND ((o.label LIKE 'porady'
OR o.label LIKE 'porady %'
OR o.label LIKE '% porady %'
OR o.label LIKE '% porady')
OR (t.tag LIKE 'porady'
OR t.tag LIKE 'porady %'
OR t.tag LIKE '% porady %'
OR t.tag LIKE '% porady')
OR (o.offeror LIKE 'porady'
OR o.offeror LIKE 'porady %'
OR o.offeror LIKE '% porady %'
OR o.offeror LIKE '% porady'))
UNION 
SELECT o.offerid,
1,
a.attributeid,
'
porady'
FROM   offers o
LEFT JOIN offerattr oa
ON oa.offerid = o.offerid
LEFT JOIN attributes a
ON a.attributeid = oa.attributeid
LEFT JOIN attributetagassign ota
ON ota.attributeid = a.attributeid
LEFT JOIN tags t
ON t.tagid = ota.tagid
LEFT JOIN offerpromotypeassign opta
ON opta.offerid = o.offerid
WHERE  o.Begindatetimenow()
AND ((oa.valuetext LIKE 'porady')
OR (oa.valuefloat LIKE 'porady')
OR (oa.valuedate LIKE 'porady')
OR (oa.valuetime LIKE 'porady')
OR (oa.valueint LIKE 'porady'))

Masowy import danych z Excel-a

Majówka w pełni :) Korzystając z chwili wolnego czasu napisałem klasę masowo importującą wiele identycznych arkuszy w jedną spójną całość. Wbrew pozorom nie jest to takie łatwe zadanie :( ale po kilku godzinach walki udało mi się stworzyć coś takiego klasa C_MASS_IMPORT
Przykład wykorzystania jest poniżej:

Sub work()
    Dim im As New C_MASS_IMPORT

    im.BaseFile = "C:\Users\Orzemek\Documents\Report_file.mdb"
    im.ImportFromFile "C:\Users\Orzemek\Documents\Report1.XLS", False, Array("Sheet2", "Sheet3", "Sheet4")
    im.ImportFromFile "C:\Users\Orzemek\Documents\Report1.XLS", True
        
    ' tworzenie QueryTable
    im.CreateQt Sheet1.Range("A1"), , "wynik scalenia"
    
    
    ' Tworzenie Pivot-a
    im.CreatePv Sheet2.Range("A1"), , "wynik scalenia"
    
End Sub

Zasada działania jest prosta: wskazujemy plik roboczy MDB, jak go nie ma to zostanie stworzony.
Kolejnym krokiem jest import zakładek z pliku, jak nie wskażemy konkretnych to mechanizm będzie chciał importować wszystkie naraz. Parametr true / False widoczny w przykładzie sprawia że dane nie zostaną (true) lub nie zostaną (False) nadpisane
Ostatni krok to stworzenie obiektu QueryTable w wybranym arkuszu, fajne, lecz niekonieczne

Edit:
Dodałem możliwość łatwego tworzenia pivot-a z tabeli będącej wynikiem scalenia
Poprawiłem też link - jest do nowszej wersji