Get Sheet Names without opening the workbook using VBA

Sometimes there could be a scenario where you may want to access the sheet names of a workbook without  opening the file.

This is possible using Activex data objects (ADO)

This code retrieves the sheet names of a workbook without opening the file.

Tested for below format:
.xlsx        .xlsm     .xls 

References :  (Goto VB  IDE >Tools > Refernces )

1. Microsoft ActiveX Data Object X.X Library
2. Microsoft ADO Ext. X.X for DLL and Security

In 2010 Excel this is how references look like

Code:(In New Module)

Option Explicit

Function GetSheetsNames(WBName As String) As Collection

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

sConnString = "Provider=Microsoft.ace.OLEDB.12.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=Excel 8.0;"

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, "'", "")
sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
On Error Resume Next
Col.Add sSheet, sSheet
On Error GoTo 0
Next tbl
Set GetSheetsNames = Col
objConn.Close
Set objCat = Nothing
Set objConn = Nothing
End Function


Sub Get_File_Names()
Dim Col As Collection, i As Long
Dim FilePathName
Dim wBook As String
FilePathName = Application.GetOpenFilename("xls Files (*.xls*), *.xls*")
If FilePathName <> False Then
  wBook = FilePathName
  Set Col = GetSheetsNames(wBook)
  For i = 1 To Col.Count
    MsgBox Col(i)
  Next i
End If
End Sub