Question

我正在尝试从访问数据库填充组合框或下拉列表。我使用以下网站作为代码模板。我对其进行了修改以满足自己的需求。我不断收到错误消息：5941集合中所请求的成员不存在。

源代码：http://www.fontstuff.com/mailbag/qword02.htm

我的代码：

Private Sub Document_Open()
    On Error GoTo Document_Open_Err

    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset

    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=*path to database removed for post*;"
    rst.Open "SELECT DISTINCT TOP 25 [Equipment] FROM tblEquipment ORDER BY [Equipment];", _
        cnn, adOpenStatic
    rst.MoveFirst

    With ActiveDocument.FormFields("Equipment").DropDown.ListEntries
        .Clear
        Do
            .Add rst![Equipment]
            rst.MoveNext
        Loop Until rst.EOF
    End With
Document_Open_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
Document_Open_Err:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume Document_Open_Exit
End Sub

几乎可行的代码：

Private Sub Document_Open()
    On Error GoTo Document_Open_Err

    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset

    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=*removed for post*;"
    rst.Open "SELECT DISTINCT TOP 25 [Field1] FROM Equipment_List ORDER BY [Field1];", _
        cnn, adOpenStatic
    rst.MoveFirst

    With ActiveDocument.FormFields("Equipment").DropDown.ListEntries
        .Clear
        Do
            .Add rst![Field1]
            rst.MoveNext
        Loop Until rst.EOF
    End With
Document_Open_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
Document_Open_Err:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume Document_Open_Exit
End Sub

Answer 1

我在这里更新我的最新帖子。参见下面的代码；设置DAO的参考，并进行一些小调整以满足您的需求。

Option Explicit
'Requires a reference to the '"Microsoft DAO 3.51 (or 3.6) Object Library."
Private Sub Userform_Initialize()
Dim myDataBase As DAO.Database
Dim myActiveRecord As DAO.Recordset
Dim i As Long
  'Open the database to retrieve data
  Set myDataBase = OpenDatabase("D:\Data Stores\sourceAccess.mdb")
  'Define the first recordset
  Set myActiveRecord = myDataBase.OpenRecordset("Table1", dbOpenForwardOnly)
  'Set the listbox column count
  ListBox1.ColumnCount = myActiveRecord.Fields.Count
  i = 0
  'Loop through all the records in the table until the EOF marker is reached.
  Do While Not myActiveRecord.EOF
    'Use .AddItem method to add a new row for each record
    ListBox1.AddItem
    ListBox1.List(i, 0) = myActiveRecord.Fields("Employee Name")
    ListBox1.List(i, 1) = myActiveRecord.Fields("Employee DOB")
    ListBox1.List(i, 2) = myActiveRecord.Fields("Employee ID")
    i = i + 1
    'Get the next record
    myActiveRecord.MoveNext
  Loop
  'Close the database and clean-up
  myActiveRecord.Close
  myDataBase.Close
  Set myActiveRecord = Nothing
  Set myDataBase = Nothing
lbl_Exit:
  Exit Sub
End Sub

Private Sub CommandButton1_Click()
Dim oRng As Word.Range
Dim oBM As Bookmarks
  Set oBM = ActiveDocument.Bookmarks
  Set oRng = oBM("EmpName").Range
  oRng.Text = ListBox1.Text
  oBM.Add "EmpName", oRng
  Set oRng = oBM("EmpDOB").Range
  oRng.Text = ListBox1.List(ListBox1.ListIndex, 1)
  oBM.Add "EmpDOB", oRng
  Set oRng = oBM("EmpID").Range
  oRng.Text = ListBox1.List(ListBox1.ListIndex, 2)
  oBM.Add "EmpID", oRng
  Me.Hide
lbl_Exit:
  Exit Sub
End Sub

代码来源：

https://gregmaxey.com/word_tip_pages/populate_userform_listbox_or_combobox.html

MS Access数据库中的MS Word下拉列表或组合框

1 个答案: