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

时间:2022-02-09 09:10:34

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!

任何有任何建议让它工作?提前致谢!

1 个解决方案

#1


1  

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

#1


1  

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