Skapa och hantera QueryTables via VBA
För att manuellt skapa QueryTables, dvs dynamiska datafrågor, krävs att vi har tillgång till MS Query. Detta tilläggsverktyg är inte alltid tillgängligt, i synnerhet om vi arbetar i större organisationer med centralt styrda Office-installationer.I VBA behöver vi inte ha tillgång till tilläggsverktyget utan vi kan hantera QueryTables på ett relativt enkelt sätt, vilket nedanstående exempel visas.
Om vi använder oss av ADO, måste vi vara medvetna om att QueryTables per se inte stödjer ADO utan enbart ODBC. Vill vi manipulera QueryTables krävs således att vi har skapat dessa mha ODBC.
Det får idag betraktas som en kraftig begräsning med QueryTables i VBA.
För att ADO-exemplet ska fungera krävs att en referens till Microsoft ActiveX Data Objekt 2.x Library anges via Verktyg | Referenser i VB-editorn.
Om vi tycker att det är en tidkrävande process att hämta data och att vi inte vill Excel ska vara låst kan vi infoga följande kod:
With qTable
.BackgroundQuery = True
'Annan kod.
.Refresh BackgroundQuery:=False
End With
Option Explicit
Option Private Module
Dim qtData As QueryTable
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnStart As Range
Dim stSQL As String
'Anslutningssträng för ADO-exemplet.
Const stADO As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=False;" & _
"Initial Catalog=Northwind;" & _
"Data Source=IBM"
'Anslutningssträng för ODBC-exemplet.
Const stODBC As String = "ODBC;DSN=MS Access Database;" & _
"DBQ=C:\Northwind.mdb;DefaultDir=C:\;" & _
"DriverId=25;FIL=MS Access;" & _
"MaxBufferSize=2048;PageTimeout=5;"
Sub Add_QueryTable_ADO()
'© 2005 Alla rättigheter XL-Dennis
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)
With wsSheet
Set rnStart = .Range("A1")
End With
stSQL = "SELECT * FROM Shippers;"
Set cnt = New ADODB.Connection
With cnt
.CursorLocation = adUseClient
.Open stADO
Set rst = .Execute(stSQL)
End With
'Här adderas Recordset till den skapade QueryTable.
Set qtData = wsSheet.QueryTables.Add(rst, rnStart)
'För att visa data måste vi uppdatera QueryTable.
qtData.Refresh
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
End Sub
Sub Add_QueryTable_ODBC()
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)
With wsSheet
Set rnStart = .Range("A1")
End With
stSQL = "SELECT * FROM Shippers;"
Set qtData = wsSheet.QueryTables.Add( _
Connection:=stODBC, _
Destination:=rnStart, _
Sql:=stSQL)
qtData.Refresh
End Sub
Sub Clear_ResultRange_Delete_Query()
'Ta bort all data men bibehåller QueryTable.
With Worksheets(1)
.QueryTables(1).ResultRange.ClearContents
End With
'Ta bort QueryTable men bibehåller all data.
With Worksheets(1)
.QueryTables(1).Delete
End With
End Sub
Sub UpDate_QueryTable_ODBC_Only()
Dim qtData As QueryTable
Dim rnShipperID As Range
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)
With wsSheet
Set rnShipperID = .Range("K10")
Set qtData = .QueryTables(1)
End With
stSQL = "SELECT * FROM Shippers WHERE ShipperID=" & rnShipperID.Value & ";"
'Uppdatera SQL-frågan via egenskapen Sql.
With qtData
.Sql = stSQL
.Refresh
End With
'Uppdatera SQL-frågan via egenskapen CommandText
With qtData
.CommandText = stSQL
.Refresh
End With
End Sub
Sub Retrieve_Contents_QueryTable_ODBC_Only()
With Worksheets(1).QueryTables(1)
'Skriver ut den nuvarande SQL-frågan.
Debug.Print .Sql
'Skriver ut den nuvarande SQL-frågan.
Debug.Print .CommandText
'Skriver ut kopplingssträngen.
Debug.Print .Connection
End With
End Sub
Sub UpDate_QueryTable_Only_ODBC_Simple_Parameterized_Question()
Dim qtData As QueryTable
Dim rnShipperID As Range
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)
With wsSheet
Set rnShipperID = .Range("K10")
Set qtData = .QueryTables(1)
End With
stSQL = "SELECT * FROM Shippers WHERE ShipperID=?;"
'Uppdatera SQL-frågan via egenskapen Sql.
With qtData
.Sql = stSQL
.Refresh
End With
'Uppdatera SQL-frågan via egenskapen CommandText.
With qtData
.CommandText = stSQL
.Refresh
End With
End Sub
Sub Iterate_Through_QueryTable_Collection()
Dim qTable As QueryTable
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets(1)
For Each qTable In wsSheet.QueryTables
'Skriver ut samtliga QueryTables namnen i det aktuella arbetsbladet.
Debug.Print qTable.Name
Next qTable
End Sub