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