View Single Post
 
Old 10-19-2014, 04:57 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,106
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The problem relates to your initialization string which includes

UserForm1.ComboBox1

whereas you have called the userform oFrm from the calling macro

Change it to

Me.ComboBox1

or just ComboBox1


but try the following instead, which will allow you to configure which column to display and set a prompt text for combo boxes.

Code:
Option Explicit
Private RS As Object
Private CN As Object
Private numrecs As Long, q As Long
Private strWidth As String
Public Function xlFillList(ListOrComboBox As Object, _
                           iColumn As Long, _
                           strWorkbook As String, _
                           strRange As String, _
                           RangeIsWorksheet As Boolean, _
                           RangeIncludesHeaderRow As Boolean, _
                           Optional PromptText As String = "[Select Item]")


    If RangeIsWorksheet = True Then strRange = strRange & "$]"

    Set CN = CreateObject("ADODB.Connection")


    If RangeIncludesHeaderRow Then
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    Else
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
    End If


    Set RS = CreateObject("ADODB.Recordset")
    RS.CursorLocation = 3

    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1        'read the data from the worksheet

    With RS
        .MoveLast
        numrecs = .RecordCount
        .MoveFirst
    End With

    With ListOrComboBox
        .ColumnCount = RS.Fields.Count
        .Column = RS.GetRows(numrecs)

        strWidth = vbNullString
        For q = 1 To .ColumnCount
            If q = iColumn Then
                If strWidth = vbNullString Then
                    strWidth = .Width - 4 & " pt"
                Else
                    strWidth = strWidth & .Width - 4 & " pt"
                End If
            Else
                strWidth = strWidth & "0 pt"
            End If
            If q < .ColumnCount Then
                strWidth = strWidth & ";"
            End If
        Next q
        .ColumnWidths = strWidth
        If TypeName(ListOrComboBox) = "ComboBox" Then
            .AddItem PromptText, 0
            If Not iColumn - 1 = 0 Then .Column(iColumn - 1, 0) = PromptText
            .ListIndex = 0
        End If
    End With

    'Cleanup
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing

lbl_Exit:
    Exit Function
End Function
Call it with

Code:
Private Sub UserForm_Initialize()
    xlFillList UserForm1.ComboBox1, 1, "E:\path_to_file\test.xlsx", "Sheet1", True, True
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote