onedaywhen wrote ...

Jake,
Your function enumerated all my worksheets *and* my 'named ranges',
however some results were missing a trailing character, e.g.

'Sheet Name Has $ dollar and gap$
(should be 'Sheet Name Has $ dollar and gap$')

'Sheet Name Has $ dollar and gap$'MyNam
(should not appear at all)

It was a bit cowardly of me not to post suggested amendments, wasn't
it? I'm still unsure whether publicly correcting a MVP leads to me
being proposed or blackballed at the next MVP annual conference and
dinner dance.

Oh well, here goes (I drink soup audibly, which I've heard leads to an
instant blackball anyhow):

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 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
For nRowCounter = 0 To nRows - 1
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)

nShtNum = nShtNum + 1
End If

.MoveNext
Next
.Close
End With
adCn.Close

GetWSNames = asSheets

End Function

--