Word Combobox From a Database

Thank rheitzman

For some strange reason, it only seems to work after pressing F8 and stepping through the lines?

When opening the document for the first time, it just doesn't display anything?

Try this test stub from the ThisDocument module and see if it works.

It might be the the sub somehow got disconnected from the event - try deleting all the code and recreating the UserForm.Initialize event and pasting the code back in.

Nope, still doesn't work unless you F8 each time.  

I modified "Private Sub UserForm_Initialize()" TO "Private Sub ComboBox1_Initialize()" but that doesn't make much difference either.

I forgot to include the test code:

Sub x()
    Dim frm As New UserForm1
    frm.Show
End Sub

Place this sub in the ThisDocument module, place cursor in the code, and hit F5 to run.

It may be that your Initialize code isn't getting executed.

Did you change the .AddItem to use the .Value property?

Try using F5 instead of F8 and see if the form displays with the combobox populated.

Hi rheitzman,

Yes - pressing F5 instead of F8 populates the combobox.  

I put your code into "ThisDocument" and it produced an error message, "Compile Error: User-defined type not defined.

Sorry, I forgot to mention that yes, I have changed the .Additem to use the.Value property.

This is how my code now looks;

Sub x()
    Dim frm As New UserForm
    frm.Show
End Sub

Private Sub UserForm_Initialize()
    On Error GoTo UserForm_Initialize_Err
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=C:\db\Names.mdb"
    rst.Open "SELECT DISTINCT [StaffNames] FROM tblNames ORDER BY [StaffNames];", _
             cnn, adOpenStatic
    rst.MoveFirst
    With Me.ComboBox1
        .Clear
        Do
            .AddItem rst![StaffNames].Value
            rst.MoveNext
        Loop Until rst.EOF
    End With
UserForm_Initialize_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
UserForm_Initialize_Err:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume UserForm_Initialize_Exit
End Sub

Try again to run the code from the ThisDocument module:

Sub x()
    Dim frm As New UserForm1
    frm.Show
    MsgBox frm.ComboBox1.Text & ""
End Sub

You may have a different name for your form instead of UserForm1

The test here is to see if the Initialize event fires on your form. Place a Stop or Breakpoint in the Initialize code if the combobox list isn't getting populated.

Is the combo box on a Document page or on a UserForm?

The code you posted is from a UserForm. If the combobox is a control on a Word page (maybe a Word page that is a form) the code needs to be in the Document Open event for a regular document or Document New for a template.

Have done this and it just doesn't work.  Does using the code I posted above work for you?
I have just created a new document with a combobox and pasted the code in and still it doesn't work unless I manually run the code from the Code View.

If I put your code "sub x()... in the "ThisDocument" modile, I get compile errors.

I posted the above before I saw your next post.
Yes, the combobox is in a Document.

So this is how it looks now; (Still not working though)...

Private Sub Document_New()
 On Error GoTo Document_New_Err
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=C:\db\Names.mdb"
    rst.Open "SELECT DISTINCT [StaffNames] FROM tblNames ORDER BY [StaffNames];", _
             cnn, adOpenStatic
    rst.MoveFirst
    With Me.ComboBox1
        .Clear
        Do
            .AddItem rst![StaffNames].Value
            rst.MoveNext
        Loop Until rst.EOF
    End With
Document_New_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
Document_New_Err:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume Document_New_Exit
End Sub