用VBA实现Excel中带参数的表格查询

Question

下面是我在Excel中创建参数化查询所需的代码。我正在运行MS Excel 2013。我正在尝试连接到SQL Server数据库。从这里开始，我想使用一个单元格来查询这个数据库，在这个单元格中，您输入一列的值，它将查询数据库中该列中的所有行( where子句)。这个单元格应该是动态的，所以当您更改其中的值时，它会更改查询的结果。下面是我拥有的代码

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

在以下位置：

    With qt
    .CommandText = sSQL
    .CommandType = xlCmdSql
    .AdjustColumnWidth = True  'add any other table properties here
    .BackgroundQuery = False
    .Refresh
    End With

我一直在.Refresh部分得到一个错误。有人能帮上忙吗？这是我的DB Database link的链接

我正在运行SQL Server Express，服务器是.\SQLEXPRESS。如果有人能帮上忙，我将不胜感激。

Answer 1

生成针对AdventureWorksDW2012的动态参数化查询的VBA代码。

将参数放入单元格A1中，例如USD。

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

如果没有安装AdventureWorksDW2012，您可以使用以下代码使用DimCurrency表的迷你版创建数据库，该表只包含几行...

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')

一定要使用ODBC驱动程序，因为如果您想要基于电子表格参数创建动态查询，ODBC驱动程序似乎是唯一的选择。我认为使用OLE DB驱动程序是不可能的。不过，我希望有一天有人能证明我错了。

没有结果？记住将USD (EUR或SEK)放在单元格A1中，查询将自动更新。