如何在更改下拉列表时在 VBA 中从 Excel 运行 SQL 查询
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/3542444/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to run a SQL Query from Excel in VBA on changing a Dropdown
提问by OpenDataAlex
I'm trying to create a dropdown that upon changing the selection from the list of options will run a query that will insert the query results into the page. Here's what I have thus far:
我正在尝试创建一个下拉列表，在更改选项列表中的选择后，将运行一个查询，将查询结果插入到页面中。这是我到目前为止所拥有的：
Sub DropDown1_Change()
Dim dbConnect As String
Dim leagueCode As String
Dim leagueList As Range
Dim leagueVal As String
Dim TeamData As String
Set leagueList = Worksheets("Menu Choices").Range("A5:A10")
Set leagueVal = Worksheets("Menu Choices").Cell("B1").Value
leagueCode = Application.WorksheetFunction.Index(leagueList, leagueVal)
TeamData = "SELECT DISTINCT(Teams.teamID), name FROM Teams WHERE lgID = '" & leagueCode & "' & ORDER BY name ASC"
With Worksheets("Menu Choices").QueryTables.Add(Connection:=dbConnect, Destination:=Worksheets("Menu Choices").Range("D5"))
.CommandText = TeamData
.Name = "Team List Query"
.Refresh BackgroundQuery:=False
End With
End Sub
Anywho have any suggestions to get it working? Thanks in advance!
任何人有任何建议让它工作吗？提前致谢！
采纳答案by OpenDataAlex
I was able to resolve the issue using similar code to the following:
我能够使用与以下类似的代码解决该问题：
Sub createTeamList()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
Dim inc As Integer
Dim topCell As Range
Dim leagueID As String
Dim leagueList As Range
Dim leagueChoice As Range
Set leagueList = Worksheets("Menu Choices").Range("A4:A9")
Set leagueChoice = Worksheets("Menu Choices").Range("B1")
leagueID = Application.WorksheetFunction.Index(leagueList, leagueChoice)
Set topCell = Worksheets("Menu Choices").Range("D4")
With topCell
Range(.Offset(1, 0), .Offset(0, 1).End(xlDown)).ClearContents
End With
With cn
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\lahman_57.mdb"
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.Open
End With
inc = 0
SQL = "SELECT teamID, name " _
& "FROM Teams " _
& "WHERE lgID = '" & leagueID & "' " _
& "GROUP BY teamID, name " _
& "ORDER BY name "
rs.Open SQL, cn
With rs
Do Until .EOF
topCell.Offset(inc, 0) = .Fields("teamID")
topCell.Offset(inc, 1) = .Fields("name")
inc = inc + 1
.MoveNext
Loop
End With
rs.Close
cn.Close
End Sub
