Fill combo with Excel sheet names

D

Del

How can I fill a combo box in Access 2000 with the sheet names from any given
Excel workbook?
 
K

Ken Snell \(MVP\)

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.
 
D

Daniel Pineault

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.
 
G

Graham Mandeno

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 )
 
D

Del

Thanks guys. All this code is outside my comfort zone in VBA, but it will
for me to be stretched.
 
Top