如何在VBA中从Excel中运行SQL查询来更改下拉列表

我试图创build一个下拉列表，当从选项列表中改变select将运行一个查询，将查询结果插入到页面中。 这是我到目前为止：

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 

任何有任何build议让它工作？ 提前致谢！

Answer 1

我能够使用类似的代码来解决这个问题：

 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