Option Explicit
Public mySheetname$
Public bln As Boolean
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.Jet.OLEDB.4.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 SheetExistsClosed()
mySheetname = InputBox("Enter sheet name to check for existence:", "Sheet name verification", "Sheet1")
If mySheetname = "" Then Exit Sub
bln = False
Dim Col As Collection, Book As String, i As Long
Book = "C:\Your\File\Path\YourFileName.xls"
Set Col = GetSheetsNames(Book)
For i = 1 To Col.count
If mySheetname = Col(i) Then
bln = True
Exit For
End If
Next i
If bln = True Then
'Sheet name does exist in that workbook of interest
MsgBox mySheetname & " exists in the subject workbook.", 64, "OK to proceed"
Else
'Sheet name does NOT exist in that workbook of interest
MsgBox mySheetname & " does NOT exist in the subject workbook.", 64, "Do not proceed"
End If
End Sub