vba 使用 SQL 数据自动填充组合框

Auto-Populating a Combobox with SQL data

提问by Carlos80

I'm new to this forum, so apologies if this has already been asked and I haven't found it or if I'm posting in the wrong place.

我是这个论坛的新手，如果有人问过这个问题但我没有找到它或者我在错误的地方发帖，我深表歉意。

I have a routine that I have been using for years which populates a combobox based on data from SQL. I have a spread sheet with two comboboxes in it, the first combobox works fine and give a list of folder names straight from a SQL table. The second combobox is populated with all of the contracts that are associated with folder selected in the first combobox. However I can't get the code to auto-populate, in order to get the combobox to update I have to select an item from the drop down list first and then the value isn't held. I have pasted my code below:

我有一个多年来一直使用的例程，它根据来自 SQL 的数据填充组合框。我有一个包含两个组合框的电子表格，第一个组合框工作正常，并直接从 SQL 表中给出文件夹名称列表。第二个组合框填充了与在第一个组合框中选择的文件夹相关联的所有合同。但是我无法让代码自动填充，为了让组合框更新，我必须先从下拉列表中选择一个项目，然后不保留该值。我在下面粘贴了我的代码：

Private Sub CB_Company_Change()

With Application
     .Calculation = xlManual
     .EnableEvents = False
     .ScreenUpdating = False
 End With

Dim stSQL As String, sBook As String, rst As ADODB.Recordset, k As Integer, vaData As Variant
Dim objConn As ADODB.Connection
Dim ConnectionString As String
ConnectionString = "Provider=sqloledb.1;data source=sql-server;Initial catalog=sql-db;Integrated Security = SSPI;"

Set objConn = New ADODB.Connection

sBook = CB_Book.Value
CB_Company.Clear

stSQL = "EXEC('SELECT Name FROM TABLE1 INNER JOIN TABLE2 ON TABLE1.ID = TABLE2.ID WHERE TABLE2.NAME = ''" & sBook & "''  ORDER BY TABLE1.NAME')"

With objConn
    .CursorLocation = adUseClient
    .Open ConnectionString
    Set rst = .Execute(stSQL)
End With

With rst
    Set .ActiveConnection = Nothing
    k = .Fields.Count
    vaData = .GetRows
End With

CB_Company.List = Application.Transpose(vaData)

objConn.Close

Set rst = Nothing
Set objConn = Nothing

bClear = True

With Application
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Any help on why this might not be auto populating when run would be much appreciated.

任何有关为什么在运行时可能不会自动填充的帮助将不胜感激。

As requested here is the code from the first combobox that gives me my book value:

根据这里的要求，第一个组合框中的代码为我提供了账面价值：

Option Explicit
Public bClear As Boolean

Private Sub CB_Book_Change()

With Application
    .Calculation = xlManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

Dim stSQL As String, rst As ADODB.Recordset, k As Integer, vaData As Variant
Dim objConn As ADODB.Connection
Dim ConnectionString As String
ConnectionString = "Provider=sqloledb.1;data source=SQL-SERVER;Initial catalog=SQL-DB;Integrated Security = SSPI;"
Set objConn = New ADODB.Connection

stSQL = "EXEC('SELECT NAME FROM TABLE2')"

With objConn
    .CursorLocation = adUseClient
    .Open ConnectionString
    Set rst = .Execute(stSQL)
End With

With rst
    Set .ActiveConnection = Nothing
    k = .Fields.Count
    vaData = .GetRows
End With

CB_Book.List = Application.Transpose(vaData)

objConn.Close

Set rst = Nothing
Set objConn = Nothing

bClear = True

With Application
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

回答by Carlos80

It looks like this is the event handler for when you select a value from CB_Company, but in the code you clear that same combobox (CB_Company.clear) and repopulate it (CB_Company.List = Application.Transpose(vaData)).

看起来这是您从 CB_Company 中选择值时的事件处理程序，但在代码中您清除了相同的组合框 (CB_Company.clear) 并重新填充它 (CB_Company.List = Application.Transpose(vaData))。

回答by enderland

I had this exact problem recently. What is happening is the "Change" method gets called frequently within itself while updating content. For example:

我最近遇到了这个确切的问题。发生的事情是在更新内容时，“Change”方法在其自身内被频繁调用。例如：

CB_Company.Clear

will actually cause this entire method to get called again. At some point, Excel stops processing these, leaving a blank box.

实际上会导致整个方法再次被调用。在某些时候，Excel 停止处理这些，留下一个空白框。

You should simply include a global variable like at the top of this module:

您应该简单地在此模块的顶部包含一个全局变量：

Public updatingContent As Boolean

Then, at the beginning of this sub include:

然后，在这个子的开头包括：

If updatingContent Then Exit Sub
updatingContent = True

This will prevent calls chaining.

这将防止调用链接。

Last, at the end of this handler, make sure to include:

最后，在此处理程序的末尾，确保包括：

updatingContent = False

to reset your method.

重置您的方法。

---

---

Here's your code with those changes.

这是带有这些更改的代码。

Public updatingContent As Boolean
Private Sub CB_Company_Change()

    If updatingContent Then Exit Sub
    updatingContent = True

    With Application
         .Calculation = xlManual
         .EnableEvents = False
         .ScreenUpdating = False
     End With

    Dim stSQL As String, sBook As String, rst As ADODB.Recordset, k As Integer, vaData As Variant
    Dim objConn As ADODB.Connection
    Dim ConnectionString As String
    ConnectionString = "Provider=sqloledb.1;data source=sql-server;Initial catalog=sql-db;Integrated Security = SSPI;"

    Set objConn = New ADODB.Connection

    sBook = CB_Book.value
    CB_Company.Clear

    stSQL = "EXEC('SELECT Name FROM TABLE1 INNER JOIN TABLE2 ON TABLE1.ID = TABLE2.ID WHERE TABLE2.NAME = ''" & sBook & "''  ORDER BY TABLE1.NAME')"

    With objConn
        .CursorLocation = adUseClient
        .Open ConnectionString
        Set rst = .Execute(stSQL)
    End With

    With rst
        Set .ActiveConnection = Nothing
        k = .fields.count
        vaData = .GetRows
    End With

    CB_Company.List = Application.Transpose(vaData)

    objConn.Close

    Set rst = Nothing
    Set objConn = Nothing

    bClear = True

    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    updatingContent = False
End Sub