The first sub will write the test data which is some soccer statistics, run this once only. The second sub does the query and you will see that it successfully does a join.
Here is the standard module
Attribute VB_Name = "modADOExample"
Option Explicit
'*Tools->References : Microsoft ActiveX Data Object 2.8 Library
Sub RunOnceToSetupTestData()
'* assumes a fresh new workbook
Dim shNew(1 To 3) As Excel.Worksheet
Dim lLoop As Long
For lLoop = 1 To 3
Set shNew(lLoop) = Nothing
On Error Resume Next
Set shNew(lLoop) = ThisWorkbook.Worksheets.Item("Sheet" & lLoop)
On Error GoTo 0
If shNew(lLoop) Is Nothing Then
If lLoop = 1 Then
Set shNew(lLoop) = ThisWorkbook.Worksheets.Add
Else
Set shNew(lLoop) = ThisWorkbook.Worksheets.Add(After:=shNew(lLoop - 1))
End If
shNew(lLoop).Name = ("Sheet" & lLoop)
End If
Next lLoop
Dim sh As Excel.Worksheet: Set sh = shNew(1)
sh.Name = "Players"
ReDim v(1 To 5) As Variant
v(1) = [{"Player","Club","Nationality","Goals";"Diego Costa","Chelsea","Spain",15;"Alexis Sánchez","Arsenal","Chile",15;"Jermain Defoe","Sunderland","England",14;"Zlatan Ibrahimovic","Manchester United","Sweden",14}]
v(2) = [{"Romelu Lukaku","Everton","Belgium",14;"Harry Kane","Tottenham Hotspur","England",13;"Sergio Agüero","Manchester City","Argentina",11;"Dele Alli","Tottenham Hotspur","England",11;"Eden Hazard","Chelsea","Belgium",10}]
v(3) = [{"Christian Benteke","Crystal Palace","Belgium",9;"Sadio Mané","Liverpool","Senegal",9;"Michail Antonio","West Ham United","England",8;"Roberto Firmino","Liverpool","Brazil",8;"Olivier Giroud","Arsenal","France",8}]
v(4) = [{"Fernando Llorente","Swansea City","Spain",8;"Theo Walcott","Arsenal","England",8;"Troy Deeney","Watford","England",7;"Adam Lallana","Liverpool","England",7;"Salomón Rondón","West Bromwich Albion","Venezuela",7}]
v(5) = [{"Gylfi Sigurdsson","Swansea City","Iceland",7;"","","",""}]
Dim lRowIndex As Long: lRowIndex = 0
Dim lChunkLoop As Long
For lChunkLoop = 1 To 5
Dim vWrite As Variant
vWrite = v(lChunkLoop)
Dim lChunkRowsCount As Long
lChunkRowsCount = UBound(vWrite, 1) - LBound(vWrite, 1) + 1
sh.Cells(1, 1).Offset(lRowIndex).Resize(lChunkRowsCount, UBound(vWrite, 2) - LBound(vWrite, 2) + 1).Value2 = vWrite
lRowIndex = lRowIndex + lChunkRowsCount
Next
Set sh = shNew(2)
sh.Name = "Clubs"
ReDim v(1 To 5) As Variant
v(1) = [{"Club","Wins";"Chelsea",19;"Arsenal",14;"Manchester City",14;"Liverpool",13}]
v(2) = [{"Tottenham Hotspur",13;"Manchester United",11;"Everton",10;"Burnley",9;"West Bromwich Albion",9}]
v(3) = [{"West Ham United",8;"AFC Bournemouth",7;"Southampton",7;"Stoke City",7;"Watford",7}]
v(4) = [{"Swansea City",6;"Crystal Palace",5;"Leicester City",5;"Hull City",4;"Middlesbrough",4}]
v(5) = [{"Sunderland",4;"",""}]
lRowIndex = 0
For lChunkLoop = 1 To 5
vWrite = v(lChunkLoop)
lChunkRowsCount = UBound(vWrite, 1) - LBound(vWrite, 1) + 1
sh.Cells(1, 1).Offset(lRowIndex).Resize(lChunkRowsCount, UBound(vWrite, 2) - LBound(vWrite, 2) + 1).Value2 = vWrite
lRowIndex = lRowIndex + lChunkRowsCount
Next
shNew(3).Name = "Join"
'ThisWorkbook.Save
End Sub
Sub Test2()
Dim oConn As ADODB.Connection
Set oConn = New ADODB.Connection
Debug.Assert UBound(Split(ThisWorkbook.Name, ".")) > 0 '* Workbook needs to be saved
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0 Macro'"
Dim rsPlayers As ADODB.Recordset
Set rsPlayers = New ADODB.Recordset
rsPlayers.Open "Select * from [Players$] AS P", oConn, adOpenStatic
Dim rsJoinExample As ADODB.Recordset
Set rsJoinExample = New ADODB.Recordset
rsJoinExample.Open "Select P.* ,C.Wins from [Players$] AS P inner join [Clubs$] as C on P.Club=C.Club", oConn, adOpenStatic
Dim rngOutput As Excel.Range
Set rngOutput = ThisWorkbook.Worksheets.Item("Join").Cells(1, 1)
Dim fldLoop As ADODB.Field
Dim lIndex As Long: lIndex = 0
For Each fldLoop In rsJoinExample.Fields
lIndex = lIndex + 1
rngOutput.Cells(1, lIndex).Value2 = fldLoop.Name
Next fldLoop
rngOutput.Offset(1).CopyFromRecordset rsJoinExample
oConn.Close
End Sub
No comments:
Post a Comment