Get worksheet names from closed workbook - revisited

[TMShucks]

I got the following code from this forum, courtesy of Juan Pablo González, MrExcelMVP.

I'm trying to use this code with an .xlsm file in Excel 2007.


However, I get a "Run-time error '-2147467259 (80004005)': External table is not in the expected format."


If I try changing "Extended Properties=Excel 8.0;" to "Extended Properties=Excel 12.0;", I get a "Run-time error '-2147467259 (80004005)': Could not find installable ISAM."


I have references to
Microsoft ActiveX Data Objects 6.1 Library and
Microsoft ADO Ext. 6.0 for DDL and Security


If I save the .xlsm file as an .xls file, the code will work. I'm hoping this is something simple as, otherwise, it's just what I'm looking for.


Regards, TMS


http://www.mrexcel.com/forum/excel-...es-closed-workbook-post216171.html#post216171

The following is a modification from the following post:

http://makeashorterlink.com/?U3C856C54 Note: the short link no longer works

It returns a collection, not an array, due to the option of "repeated" names when there is a print area setup.

I tried using the GET.WORKBOOK(1, ...) XLM macro as well, but a) doesn't work well in <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym>, and b) doesn't work with closed workbooks.

[FONT=Courier][COLOR=#333333][COLOR=#00008B]Option[/COLOR] [COLOR=#00008B]Explicit[/COLOR]

[COLOR=#00008B]Function[/COLOR] GetSheetsNames(WBName [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]String[/COLOR]) [COLOR=#00008B]As[/COLOR] Collection
****[COLOR=green]'Needs a reference to:[/COLOR]
****[COLOR=green]'Microsoft ActiveX Data Object X.X Library[/COLOR]
****[COLOR=green]'Microsoft ADO Ext. X.X for DLL and Security[/COLOR]
****
****[COLOR=#00008B]Dim[/COLOR] objConn [COLOR=#00008B]As[/COLOR] ADODB.Connection
****[COLOR=#00008B]Dim[/COLOR] objCat [COLOR=#00008B]As[/COLOR] ADOX.Catalog
****[COLOR=#00008B]Dim[/COLOR] tbl [COLOR=#00008B]As[/COLOR] ADOX.Table
****[COLOR=#00008B]Dim[/COLOR] sConnString [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]String[/COLOR]
****[COLOR=#00008B]Dim[/COLOR] sSheet [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]String[/COLOR]
****[COLOR=#00008B]Dim[/COLOR] Col [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]New[/COLOR] Collection
****
****sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
******************"Data Source=" & WBName & ";" & _
******************"Extended Properties=Excel 8.0;"

****[COLOR=#00008B]Set[/COLOR] objConn = [COLOR=#00008B]New[/COLOR] ADODB.Connection
****objConn.[COLOR=#00008B]Open[/COLOR] sConnString
****[COLOR=#00008B]Set[/COLOR] objCat = [COLOR=#00008B]New[/COLOR] ADOX.Catalog
****[COLOR=#00008B]Set[/COLOR] objCat.ActiveConnection = objConn

****[COLOR=#00008B]For[/COLOR] [COLOR=#00008B]Each[/COLOR] tbl [COLOR=#00008B]In[/COLOR] objCat.Tables
********sSheet = tbl.Name
********sSheet = Application.Substitute(sSheet, "'", "")
********sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
********[COLOR=#00008B]On[/COLOR] [COLOR=#00008B]Error[/COLOR] [COLOR=#00008B]Resume[/COLOR] [COLOR=#00008B]Next[/COLOR]
********Col.Add sSheet, sSheet
********[COLOR=#00008B]On[/COLOR] [COLOR=#00008B]Error[/COLOR] [COLOR=#00008B]GoTo[/COLOR] 0
****[COLOR=#00008B]Next[/COLOR] tbl
****[COLOR=#00008B]Set[/COLOR] GetSheetsNames = Col
****objConn.[COLOR=#00008B]Close[/COLOR]
****[COLOR=#00008B]Set[/COLOR] objCat = [COLOR=#00008B]Nothing[/COLOR]
****[COLOR=#00008B]Set[/COLOR] objConn = [COLOR=#00008B]Nothing[/COLOR]
[COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Function[/COLOR]

[COLOR=#00008B]Sub[/COLOR] Test()
****[COLOR=#00008B]Dim[/COLOR] Col [COLOR=#00008B]As[/COLOR] Collection, Book [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]String[/COLOR], i [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Long[/COLOR]
****Book = "C:\Your path\Your file.xls"
****[COLOR=#00008B]Set[/COLOR] Col = GetSheetsNames(Book)
****[COLOR=#00008B]For[/COLOR] i = 1 [COLOR=#00008B]To[/COLOR] Col.Count
********MsgBox Col(i)
****[COLOR=#00008B]Next[/COLOR] i
[COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Sub
[/COLOR][/COLOR][/FONT]

 

[RoryA]

As I mentioned in your other post () you need to use the Microsoft.ACE.OLEDB.12.0 provider, not Jet. Also, if it's a macro workbook you should strictly use "Extended Properties=Excel 12.0 Macro;"

 

[TMShucks]

Thanks Rory.

Perfect! It is, indeed, a macro enabled workbook ... didn't I say that? And that works very nicely thank you.

And now I am slightly embarrassed about a) starting a new thread here before waiting to see if I would be OK tagging on to an old thread and b) crossing over to the other side and asking there! I know, I know, I should know better

So, again, my thanks to you and Holger for coming to my rescue.

Cheers, TMS


PS: can you / do you mark threads as solved over here?

 

[TMShucks]

The updated code ...

Option Explicit


' courtesy of: Juan Pablo González (MrExcel MVP)
' http://www.mrexcel.com/forum/excel-questions/47074-get-worksheet-names-closed-workbook.html
' http://www.mrexcel.com/forum/excel-questions/47074-get-worksheet-names-closed-workbook-post216171.html#post216171


' Updated: November 2013 to cater for Excel 2007 Macro Enabled workbook
' with advice from *** RoryA *** on MrExcel
' http://www.mrexcel.com/forum/excel-questions/47074-get-worksheet-names-closed-workbook-post3637063.html#post3637063
' http://www.mrexcel.com/forum/excel-questions/740042-get-worksheet-names-closed-workbook-revisited-post3637224.html#post3637224
' and from *** HaHoBe (Holger) *** on the Excel Forum
' http://www.excelforum.com/excel-programming-vba-macros/969260-get-worksheet-names-from-closed-workbook-revisited.html#post3479659


Function GetSheetsNames(WBName As String) As Collection
'Needs a reference to:
'Microsoft ActiveX Data Objects X.X Library
'Microsoft ADO Ext. X.X for DLL and Security


Dim objConn As ADODB.Connection
Dim objCat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sConnString As String
Dim sSheet As String
Dim Col As New Collection


' connection string amended to cater for Excel 2007 Macro enabled workbook
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & WBName & ";" & _
              "Extended Properties=Excel 12.0 Macro;"
' or
' connection string amended to cater for Excel 2007 Macro enabled workbook
'sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
'              "Data Source=" & WBName & ";" & _
'              "Extended Properties=Excel 12.0 XML;"


Set objConn = New ADODB.Connection
objConn.Open sConnString
Set objCat = New ADOX.Catalog
Set objCat.ActiveConnection = objConn


For Each tbl In objCat.Tables
    sSheet = tbl.Name
    sSheet = Application.Substitute(sSheet, "'", "")
    On Error Resume Next
    sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
    Err.Number = 0
    Col.Add sSheet, sSheet
    On Error GoTo 0
Next tbl


Set GetSheetsNames = Col


objConn.Close
Set objCat = Nothing
Set objConn = Nothing
End Function


Sub Test()
Dim Col As Collection, Book As String, Sht As String, i As Long
Dim vArray
Dim ShIndex As Long
Dim awf As WorksheetFunction: Set awf = WorksheetFunction


Book = "C:test Folder\Test Workbook.xlsm"
Sht = "Test Sheet"
Set Col = GetSheetsNames(Book)


' resize an array to take the collection ...
ReDim vArray(1 To Col.Count)
' copy the collection across to the array
For i = 1 To Col.Count
    ' MsgBox Col(i)      ' OK for small workbooks but can be tedious
    vArray(i) = Col(i)
Next i


' which means I can do a match to see if the one I@m interested in is there
ShIndex = awf.Match(Sht, vArray, 0)
MsgBox ShIndex


' store the list in the active sheet
' Range("A1").Resize(UBound(vArray)).Value = awf.Transpose(vArray)
End Sub

Regards, TMS