Add Sheet Names of Closed MS Excel Workbook

[DDTiff]

Hi,

Can someone please help me? Thank you for your time and help in advance.

I have a combobox in VBA that belongs to workbook1, and I want the combobox in workbook1 to list all the sheets of workbook2 (which is a closed workbook).

Here is the code I have so far:

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub UserForm_Initialize()
Dim wb2 As Object
Set wb2 = GetObject("C:\workbook2.xls", Sheet)
With wb2
For i = 1 To sheets.Count
ComboBox1.AddItem sheets(i).Name
Next i
End With
End Sub
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

I am not sure how to make the link between workbook2 sheets and combobox1 in workbook1. Once again thank you for your help.

DDTiff

 

[SkipVought]

Hi,

Open workbook 2

Get the sheet names

Close workbook 2



Skip,
[sub]
[red]Be advised:[/red] When transmitting sheet music...
If it ain't baroque, don't fax it! [/sub]

 

[Loomah]

Hi
If you really must do it without opening the Workbook then here is one poss solution

In the form module:-

Private Sub UserForm_Initialize()
Dim i As Integer
Dim myArr
myArr = GetAllSheetNames2("X:\YouFolder\YourSubFolder\YourExcelFile.xls")
'ListBox1.List = myArr
ComboBox1.List = myArr
End Sub

and in a normal module

Function GetAllSheetNames2(fName As String) As Variant
Dim objConn As Object
Dim objCat As Object
Dim tbl As Object
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer
Dim sTempString As String
Dim iTblCount As Integer
Dim vValue As Variant

    'On Error GoTo Handler
    sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=" & fName & ";" & _
                  "Extended Properties=Excel 8.0;"

    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open sConnString
    Set objCat = CreateObject("ADOX.Catalog")
    Set objCat.ActiveConnection = objConn
       
    'Loop through all sheets in workbook and get name
    For iTblCount = 0 To objCat.tables.Count - 1
        'index appears to be base 0 but refers to created
        'rather than position in the book
        sTableName = objCat.tables(iTblCount).Name
        cLength = Len(sTableName)
        iTestPos = 0
        iStartpos = 1
            'Worksheet name with embedded spaces are enclosed by single quotes
        If Left(sTableName, 1) = "'" And Right(sTableName, 1) = "'" Then
            iTestPos = 1
            iStartpos = 2
        End If
            'Worksheet names always end in the "$" character
            sTempString = Mid$(sTableName, iStartpos, cLength - (iStartpos + iTestPos)) _
                & "," & sTempString
                
    Next
    sTempString = Left(sTempString, Len(sTempString) - 1)
    GetAllSheetNames2 = Split(sTempString, ",")
cleanExit:
    objConn.Close
    Set objCat = Nothing
    Set objConn = Nothing
    Exit Function
Handler:
    MsgBox Err.Number & "  " & Err.Description
    Resume cleanExit
End Function

You may need to work on the error hanling in the function.

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[DDTiff]

Thank you Skip and Loomah for your responses. I found a some tips online that answered my question and here is the code in generic form:

************************************************************
Private Sub UserForm_Initialize()
Dim i as Integer
Dim workbook1 as Workbook
With Me.Combobox1
.Clear 'clear existing entry in the combobox1
Application.ScreenUpdating 'prevent user from seeing the workbook1 being opened
Set workbook1=Workbooks.Open ("Your path and filename", False, True) 'open workbook1 as readonly
For i =1 to workbook1.Worksheets.count 'populate the combobox1
.AddItem Worksheets(i).name
Next i
.Listindex = 1 'display the first item from the combobox1
workbook1.close False 'close workbook1 without saving changes
End With
End Sub
***********************************************************

DDTiff