View Single Post
 
Old 07-19-2020, 03:33 PM
gmaxey gmaxey is offline Windows 10 Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,429
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

You say you don't want to open the Excel file? The second line of your code "Opens" the Excel file.

You could use and ADODB connection:

Code:
Option Explicit
Public Function xlFillList(oListOrComboBox As Object, strWorkbook As String, _
                           bSuppressHeader As Boolean, strSQL As String, _
                           bSingleColumn As Boolean)
Dim oConn As Object
Dim oRecordSet As Object
Dim lngNumRecs As Long, lngIndex As Long
Dim strWidth As String
Dim strConnection As String

  
  
  'Create connection:
  Set oConn = CreateObject("ADODB.Connection")
  If bSuppressHeader Then
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & strWorkbook & ";" & _
                    "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
  Else
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & strWorkbook & ";" & _
                    "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
  End If
  oConn.Open ConnectionString:=strConnection
  Set oRecordSet = CreateObject("ADODB.Recordset")
  'Read the data from the worksheet.
  oRecordSet.Open strSQL, oConn, 3, 1 '3: adOpenStatic, 1: adLockReadOnly
  With oRecordSet
    'Find the last record.
    .MoveLast
    'Get count.
    lngNumRecs = .RecordCount
    'Return to the start.
    .MoveFirst
  End With
  With oListOrComboBox
    .Clear
    'Load the records into the columns of the named list/combo box.
    .ColumnCount = oRecordSet.Fields.Count
    .Column = oRecordSet.GetRows(lngNumRecs)
    strWidth = vbNullString
    If bSingleColumn Then
     'Set the widths of the combo/list box columns to display only the first column.
      strWidth = .Width - 20 & " pt;"
      For lngIndex = 2 To .ColumnCount
        strWidth = strWidth & "0 pt"
        If lngIndex < .ColumnCount Then
          strWidth = strWidth & ";"
        End If
      Next lngIndex
    Else
      For lngIndex = 1 To .ColumnCount
        strWidth = strWidth & Val(.Width \ .ColumnCount) - 10 & " pt;"
      Next lngIndex
      .ColumnWidths = strWidth
    End If
  End With
Cleanup:
  If oRecordSet.State = 1 Then oRecordSet.Close
  Set oRecordSet = Nothing
  If oConn.State = 1 Then oConn.Close
  Set oConn = Nothing
lbl_Exit:
  Exit Function
End Function

Call from form like this:
Code:
Private Sub UserForm_Initialize()
Dim DataSourcePath As String
Dim strSQL As String
  DataSourcePath = ThisDocument.Path & "\Basic Fill.xlsx"
  'Get all data from sheet named "BasicI", exclude heading row, single Column
  strSQL = "SELECT * FROM [BasicI$];"
  mod_ExcelInteropSA.xlFillList lstBasicI, DataSourcePath, "True", strSQL, "True"
  'Get all data from sheet named "BasicII", including heading row, show all columns
  strSQL = "SELECT * FROM [BasicII$];"
  mod_ExcelInteropSA.xlFillList lstBasicII, DataSourcePath, "False", strSQL, "False"
  'Get data from columns headed "Name" and "Amount" from sheet named "BasicIII", exclude heading row, show all columns
  strSQL = "SELECT Name, Amount From [BasicIII$];"
  mod_ExcelInteropSA.xlFillList lstBasicIII, DataSourcePath, "True", strSQL, "False"
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote