Fill combo with Excel sheet names

  • Thread starter Thread starter Del
  • Start date Start date
D

Del

How can I fill a combo box in Access 2000 with the sheet names from any given
Excel workbook?
 
Here's one approach... this code will gather the worksheet names from a
workbook (whose path and name is in the strFileName variable) and put them
into a Collection object:

Dim obExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim strWorksheetName As String
Dim strFileName As String
Dim colWorksheets As Collection
Dim lngWorksheet As Long
Dim varWorksheet As Variant
Set colWorksheets = New Collection
strFileName = "C\test.xls"
Set obExcel = CreateObject("Excel.Application")
obExcel.Visible = False
Set objWorkbook = obExcel.Workbooks.Open(strFileName)
For lngWorksheet = 1 To objWorkbook.Worksheets.Count
strWorksheetName = objWorkbook.Worksheets(lngWorksheet).Name
If strWorksheetName = "System" Then Exit For
colWorksheets.Add strWorksheetName
Next lngWorksheet
objWorkbook.Close
Set objWorkbook = Nothing
obExcel.Quit
Set obExcel = Nothing


You can modify this code to make it a function/sub that gets the path and
filename of the EXCEL workbook, nd returns the Collection data.
 
Del.

Feel free to modify the following to suit your need, but it should
definitely get you off to a good start.

'---------------------------------------------------------------------------------------
' Procedure : ListXlsSheets
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : List the sheet name of an Excel Workbook
' Copyright : The following may be altered and reused as you wish so long as
the
' copyright notice is left unchanged (including Author, Website
and
' Copyright). It may not be sold/resold or reposted on other
sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile - The Excel file to list the sheets
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
'
**************************************************************************************
' 1 2008-Jul-15 Initial Releas
'---------------------------------------------------------------------------------------
Function ListXlsSheets(sFile As String)
'On Error GoTo Error_Handler
Dim NumSheets As Integer
Dim i As Integer
Dim xlApp As Object
Dim xlWrkBk As Object
Dim xlWrkSht As Object

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance
of Excel

If Err.Number <> 0 Then
'Could not get instance of Excel, so create a new one
Err.Clear
' On Error GoTo Error_Handler
Set xlApp = CreateObject("excel.application")
Else
' On Error GoTo Error_Handler
End If

xlApp.Visible = False 'make excel visible or not to the user
Set xlWrkBk = xlApp.Workbooks.Open(sFile)

NumSheets = xlWrkBk.Sheets.Count
For i = 1 To NumSheets
Debug.Print i & " - " & xlWrkBk.Sheets(i).Name
Next i

xlWrkBk.Close False
xlApp.Close

Set xlWrkSht = Nothing
Set xlWrkBk = Nothing
Set xlApp = Nothing

If Err.Number = 0 Then Exit Function

If Err.Number = 0 Then Exit Function

Error_Handler:
If Err.Number <> 438 Then
MsgBox "MS Access has generated the following error" & vbCrLf &
vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: ListXlsSheets" & vbCrLf &
"Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Exit Function
Else
Resume Next
End If

End Function

--
Hope this helps,

Daniel Pineault
http://www.cardaconsultants.com/
For Access Tips and Examples: http://www.devhut.net
Please rate this post using the vote buttons if it was helpful.
 
Hi Del

Some code like this should do the trick:

Function ListExcelSheets( sExcelFile as String ) as String
Dim oXL As Object
Dim oWkb As Object
Dim oSht As Object
Dim sSheets As String
On Error GoTo ProcErr
Set oXL = CreateObject("Excel.Application")
Set oWkb = oXL.Workbooks.Open( sExcelFile, , True)
For Each oSht In oWkb.Worksheets
sSheets = sSheets & oSht.Name & ";"
Next
' remove the final ; and return list
ListExcelSheets = Left(sSheets, Len(sSheets) - 1)
ProcEnd:
On Error Resume Next
oWkb.Close False
oXL.Quit
Set oWkb = Nothing
Set oXL = Nothing
Exit Function
ProcErr:
MsgBox Err.Description, vbOKOnly, "Error " & Err.Number
Resume ProcEnd
End Function

If you pass it the name of an Excel file, it will return a list of the
sheets in that workbook, separated by semicolons. So if you have a combo
with its RowSourceType set to Value List, you can just say:

cboMyCombo.RowSource = ListExcelSheets( txtMyExcelFile )
 
Thanks guys. All this code is outside my comfort zone in VBA, but it will
for me to be stretched.
 
Back
Top