Results 1 to 1 of 1
  1. #1
    Join Date
    May 2006
    Posts
    17

    Unanswered: VBA SQL ADO Listbox Combobox Issue

    Help!! I am about to tear my eyes out!!

    I am pulling a distinct list of companies into a combobox and based on the selection I want to display a list of contacts that correspond to that company. I can get the combobox to populate correctly but, i cannot get them to work together.
    I am using 2002-2003 database. And Excel 2007 to do my dirty work.
    ANY help on this would be REALLY appreciated!!!
    Code:
    Private Sub btnExit_Click()
    Unload frmSelect
    End Sub
    
    Private Sub cboCompany_AfterUpdate()
         Dim intAddNew As Integer
        If Not cboCompany.MatchFound Then _
            intAddNew = MsgBox("Would you like to add a new contact?", vbQuestion + vbYesNo, "Customer not found in list...")
        If intAddNew = vbYes Then
            Load frmNewContact
            frmNewContact.txtCompany = cboCompany.Value
            frmNewContact.txtContactName.SetFocus
            frmNewContact.Show
        Else
            frmSelect.cboCompany.SetFocus
        End If
        
        
        Dim wsSetup As Worksheet
        Dim strDatabase As String
        Dim conn As ADODB.Connection
        Dim rs As ADODB.Recordset
        Dim i As Integer
        Set wsSetup = ThisWorkbook.Worksheets("Setup")
        Set conn = New ADODB.Connection
        Set rs = New ADODB.Recordset
    
    strDatabase = wsSetup.Cells(1, 2)
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strDatabase & "'"
    conn.Open
    
    
    'Put data into the list box based on data from the combobox
    Dim strCompany As String
    
    Me.cboCompany.Value = strCompany
    
    
    Set rs = New ADODB.Recordset
    rs.Open "SELECT ContactName FROM tblCustomer WHERE Company = '" & strCompany & "'", conn, adCmdText
    
    'CURRENTLY THIS IS WHERE I GET HUNG UP.... IT SEEMS THAT THE RECORDSET IS COMING BACK EMPTY. I THINK IT IS BECAUSE THE STRING IS EMPTY THAT I AM PASSING INTO THE SQL STATEMENT.
    
    If rs.RecordCount < 1 Then
    MsgBox "No records"
    Else
    
    Me.lstContacts.ColumnCount = rs.Fields.Count
    Me.lstContacts.Column = rs.GetRows(rs.RecordCount)
    End If
    
    'I originally wanted to use this code but, it doesnt like me
    'rs.MoveFirst
    'Do Until rs.EOF
    'frmSelect.lstContacts.AddItem rs!ContactName
    'Loop
    
    'Clean up
    rs.Close
    conn.Close
    Set conn = Nothing
    Set rs = Nothing
        
        
    End Sub
    
    Private Sub cboCompany_Change()
      
     Dim wsSetup As Worksheet
        Dim strDatabase As String
        Dim conn As ADODB.Connection
        Dim rs As ADODB.Recordset
        Dim i As Integer
        Set wsSetup = ThisWorkbook.Worksheets("Setup")
        Set conn = New ADODB.Connection
        Set rs = New ADODB.Recordset
    
    strDatabase = wsSetup.Cells(1, 2)
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strDatabase & "'"
    conn.Open
    rs.Open "SELECT DISTINCT Company FROM tblCustomer ORDER BY Company ASC", conn, adCmdText
    
    If rs.RecordCount < 1 Then
    MsgBox "No records"
    Else
    
    Me.cboCompany.ColumnCount = rs.Fields.Count
    Me.cboCompany.Column = rs.GetRows(rs.RecordCount)
    
    frmSelect.lstContacts.Visible = True
    'frmSelect.lstContacts.Selected(0) = True
    Application.ScreenUpdating = True
    
    'Clean up
    rs.Close
    conn.Close
    Set conn = Nothing
    Set rs = Nothing
    End If
    End Sub
    
    Private Sub UserForm_Initialize()
                    Application.ScreenUpdating = False
                    frmSelect.lstContacts.Selected(0) = False
                    frmSelect.lstContacts.Visible = False
    End Sub
    Last edited by rizzo89; 10-25-08 at 13:45.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •