问题
Below is the code I have to create a parameterized query in Excel. I am running MS Excel 2013. What I am doing is trying to connect to a SQL Server database. From here I want to query this database using a single cell where you type in a value of a column and it queries the database for all the rows in that column (a WHERE clause). This cell is supposed to be dynamic so when you change the value in it, it changes the result from the query. Here is the code I have
Sub ParameterQueryExample()
'---creates a ListObject-QueryTable on Sheet1 that uses the value in
' Cell Z1 as the ProductID Parameter for an SQL Query
' Once created, the query will refresh upon changes to Z1.
Dim sSQL As String
Dim qt As QueryTable
Dim rDest As Range
'--build connection string-must use ODBC to allow parameters
Const sConnect = "ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=.\SQLEXPRESS;" & _
"Database=TSQL2012;" & _
"Trusted_Connection=yes"
'--build SQL statement
sSQL = "SELECT *" & _
" FROM TSQL2012.Production.Products Products" & _
" WHERE Products.productid = ?;"
'--create ListObject and get QueryTable
Set rDest = Sheets("Sheet1").Range("A1")
rDest.CurrentRegion.Clear 'optional- delete existing table
Set qt = rDest.Parent.ListObjects.Add(SourceType:=xlSrcExternal, _
Source:=Array(sConnect), Destination:=rDest).QueryTable
'--add Parameter to QueryTable-use Cell Z1 as parameter
With qt.Parameters.Add("ProductID", xlParamTypeVarChar)
.SetParam xlRange, Sheets("Sheet1").Range("Z1")
.RefreshOnChange = True
End With
'--populate QueryTable
With qt
.CommandText = sSQL
.CommandType = xlCmdSql
.AdjustColumnWidth = True 'add any other table properties here
.BackgroundQuery = False
.Refresh
End With
Set qt = Nothing
Set rDest = Nothing
End Sub
At the:
With qt
.CommandText = sSQL
.CommandType = xlCmdSql
.AdjustColumnWidth = True 'add any other table properties here
.BackgroundQuery = False
.Refresh
End With
I keep getting an error at the .Refresh section. Can anyone help? Here is a link to my DB Database link
I am running SQL Server Express and the server is .\SQLEXPRESS. If anyone can help it would be greatly appreciated.
回答1:
VBA code that generates a dynamic parameterized query against AdventureWorksDW2012.
Put the parameter, for example USD
, in cell A1.
Sub DynamicParameterizedQuery()
Dim lo As ListObject
Set lo = ActiveSheet.ListObjects.Add(xlSrcExternal, "ODBC;Driver={SQL Server Native Client 11.0};Server=.;Database=AdventureWorksDW2012;Trusted_Connection=yes", True, xlYes, Range("A2"))
lo.QueryTable.CommandType = xlCmdSql
lo.QueryTable.CommandText = "SELECT * FROM DimCurrency WHERE CurrencyAlternateKey = ?"
With lo.QueryTable.Parameters.Add("Currency code", xlParamTypeVarChar)
.SetParam xlRange, ActiveSheet.Range("A1")
.RefreshOnChange = True
End With
lo.QueryTable.Refresh BackgroundQuery:=False
End Sub
If don't have AdventureWorksDW2012 installed you can create the database with a mini version of the DimCurrency table containing only a few rows by using the following code...
USE master
GO
CREATE DATABASE AdventureWorksDW2012
GO
USE AdventureWorksDW2012
CREATE TABLE DimCurrency(
CurrencyKey int NOT NULL,
CurrencyAlternateKey nchar(3) NOT NULL,
CurrencyName nvarchar(50) NOT NULL
)
INSERT INTO DimCurrency
VALUES (36, 'EUR', 'EURO'), (100, 'USD', 'US Dollar'), (91, 'SEK', 'Swedish Krona')
Be sure to use an ODBC driver, as it seems to be the only option if you want to create a dynamic query based on a spreadsheet parameter. I don't think it's possible to use an OLE DB driver. I hope, though, that one day someone will prove me wrong.
No results? Remember to put USD
(EUR
or SEK
) in cell A1 and the Query will update automatically.
来源:https://stackoverflow.com/questions/17618796/querying-a-table-in-excel-with-parameters-using-vba