"Bob Phillips" wrote ...

This ignores sheet names with embedded spaces, they get seen as type TABLE
in your solution. If you include a test for TABLE as well, it removes the
final ' not the $. See my response for 2 ways that cater for it.

This seemingly simple task is complicated in practice <g.

A few further points in case they aren't already clear:

1) TABLE means a workbook-level defined Name ('Named Range') where the
formula to define the Range is a simple cell address e.g. excludes
'Dynamic Ranges'.

2) SYSTEM TABLE also returns worksheet level defined names, therefore
if you simply parse the sheet delimiter ($ or $') you may get
duplicates.

3) The $ and ' characters are legal in worksheet names, so if you
simply parse the sheet delimiter you may get truncated names.

4) The OLE DB Provider for Jet 4.0, being the provider most often used
with Excel and ADO, as a result of a bug (KB 300948) cannot
distinguish between TABLE and SYSTEM TABLE. The workaround is to use
the ODBC driver for Excel, and if you need to use ADO/OLEDB, couple it
with the OLE DB provider for ODBC (now considered by MS to be a
depreciated component!) as Jim has done.

5) Bob, you too are using OpenSchema <g:

PRB: Limitations of Using ADOX with Providers Other than Microsoft Jet
OLE DB Provider
http://support.microsoft.com/default...b;en-us;271483
"ADOX calls the OpenSchema method with adSchemaTables and no
restrictions."

I guess the choice is between working with a collection class object
or a recordset. I tend to go for a recordset because I can apply a
Filter to the results or use Sort (requires a client-side cursor) e.g.
when using adSchemaColumns to sort by ORDINAL_POSITION rather than
COLUMN_NAME. ADOX is essential for the advanced provider properties
and settings. For these reasons, these days I'm more often using an
ADO recordset rather than a Collection as the container object for my
VBA collection classes but that's another story...

The following code was originally written by Jake Marx, revised by
myself and seems to work for worksheet name that spaces and
non-alphanumeric characters, including $ and ', even where they
comprise sheet-level names (thought I'll be grateful to hear any
reports to the contrary):

Public Function GetWSNames( _
ByVal WBPath As String _
) As Variant
Dim adCn As Object
Dim adRs As Object
Dim asSheets() As String
Dim nShtNum As Long
Dim nRows As Long
Dim nRowCounter As Long
Dim sSheet As String
Dim sOSheet As String
Dim sChar1 As String
Dim sChar2 As String

Const INDICATOR_SHEET As String = "$"
Const INDICATOR_SPACES As String = "'"

Set adCn = CreateObject("ADODB.Connection")

With adCn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB" & _
".4.0;Data Source=" & WBPath & ";Extended " & _
"Properties=""Excel 8.0;HDR=Yes"""
.CursorLocation = 3
.Open
End With

Set adRs = adCn.OpenSchema(20)
With adRs

nRows = .RecordCount
Dim strMsg As String
For nRowCounter = 0 To nRows - 1
sOSheet = !TABLE_NAME
strMsg = "[" & sOSheet & "]"
sSheet = !TABLE_NAME
sChar1 = vbNullString
sChar2 = vbNullString
On Error Resume Next
sChar1 = Mid$(sSheet, Len(sSheet), 1)
sChar2 = Mid$(sSheet, Len(sSheet) - 1, 1)
On Error GoTo 0

Select Case sChar1

Case INDICATOR_SHEET
sSheet = Left$(sSheet, Len(sSheet) - 1)

Case INDICATOR_SPACES
If sChar2 = INDICATOR_SHEET Then
sSheet = Mid$(sSheet, 2, Len(sSheet) - 3)
End If

Case Else
sSheet = vbNullString

End Select

If Len(sSheet) 0 Then
ReDim Preserve asSheets(nShtNum)

' Un-escape
asSheets(nShtNum) = Replace(sSheet, _
INDICATOR_SPACES & INDICATOR_SPACES, _
INDICATOR_SPACES)
strMsg = strMsg & "=[" & sSheet & "]"
nShtNum = nShtNum + 1
End If

.MoveNext
Next
.Close
End With
adCn.Close

GetWSNames = asSheets

End Function


Jamie.

--