How do I test whether a defined sheetname exists in a closed workbook?

  • Thread starter Thread starter gpreg
  • Start date Start date
G

gpreg

Hi...
I've been searching all over and can't find anything on this particula
challenge so I thought you guys might be able to help!

I'm wondering if anyone knows how to test whether (or not) a specifi
sheetname (e.g. "TestSheet") exists in a closed workbook?

(I'd really prefer not to have to open the workbook if at all possibl
as its one step in an intensive consolidation process from upto 10
workbooks.)

Thx muchly!
 
Greg,

Here is a function to return True or False for the supplied file and sheet
name

Function IfSheetExists(fName As String, sh As String) As Boolean

Dim objConn As ADODB.Connection
Dim objCat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim iRow As Long
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer

IfSheetExists = False

With ActiveSheet

sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fName & ";" & _
"Extended Properties=Excel 8.0;"

Set objConn = New ADODB.Connection
objConn.Open sConnString
Set objCat = New ADOX.Catalog
Set objCat.ActiveConnection = objConn

iRow = 1
.lstSheetNames.Clear
For Each tbl In objCat.Tables
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
'Worksheet name with embedded spaces are enclosed by single
quotes
If Left(sTableName, 1) = "'" And Right(sTableName, 1) = "'" Then
iTestPos = 1
iStartpos = 2
End If
'Worksheet names always end in the "$" character
If Mid$(sTableName, cLength - iTestPos, 1) = "$" Then
If sh = Mid$(sTableName, iStartpos, cLength - (iStartpos +
iTestPos)) Then
IfSheetExists = True
Exit For
End If
End If
Next tbl
End With

objConn.Close
Set objCat = Nothing
Set objConn = Nothing

End Function




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Greg,

Forgot to mention that you need to set references to the following libraries
Microsoft ADOX Ext n.nn for DDL and Security
Microsoft ACtiveX Data Object Library

as it uses early binding

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Bob Phillips said:
Greg,

Here is a function to return True or False for the supplied file and sheet
name

Function IfSheetExists(fName As String, sh As String) As Boolean

Dim objConn As ADODB.Connection
Dim objCat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim iRow As Long
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer

IfSheetExists = False

With ActiveSheet

sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fName & ";" & _
"Extended Properties=Excel 8.0;"

Set objConn = New ADODB.Connection
objConn.Open sConnString
Set objCat = New ADOX.Catalog
Set objCat.ActiveConnection = objConn

iRow = 1
.lstSheetNames.Clear
For Each tbl In objCat.Tables
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
'Worksheet name with embedded spaces are enclosed by single
quotes
If Left(sTableName, 1) = "'" And Right(sTableName, 1) = "'" Then
iTestPos = 1
iStartpos = 2
End If
'Worksheet names always end in the "$" character
If Mid$(sTableName, cLength - iTestPos, 1) = "$" Then
If sh = Mid$(sTableName, iStartpos, cLength - (iStartpos +
iTestPos)) Then
IfSheetExists = True
Exit For
End If
End If
Next tbl
End With

objConn.Close
Set objCat = Nothing
Set objConn = Nothing

End Function




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Click to expand...
 
Thanks for the function Bob!

But I'm still playing around trying to get this working

I've set references to:
- Microsoft ActiveX Data Object *V2.5* Library
- Microsoft ACtiveX Data Object V2.5 Library

I'm getting the following error message:
Run-time error '-214767259(80004005)':
The Microsoft Jet database engine cannot open the file [filename]. I
is opened exclusively by another user, or you need permission to vie
its data.

Is this perhaps because the closed workbook has macros (in the case I'
currently testing). Opening this world normally involve dealing wit
the macro Disable/Enable/cancel dialog so I don't know if this i
perhaps triggering the error?

I guess I should have also mentioned that I'm using Excel 2000.

Thanks again
 
Greg,

It's nothing to do with macros as it reads the Table Catalog. I can read
workbooks with macros and without.

I also have XL2000.

You also need to set a reference to
Microsoft ADOX Ext n.nn for DDL and Security
the file reefrenced in this case will be MSADOX.DLL

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob...
I've adjusted the references then commented out the line I was gettin
the error on and now everythings working!

Sweet! Thanks for this - 'tis much appreciated!

BTW: Do you know if it's possible to achieve this without setting th
additional references?

Have a great day. Cheers
 
Greg,

Just tested it some more and you get that error if the file does not exit.

And the actual reference is
Microsoft ADO Ext n.nn for DDL and Security

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Bob Phillips said:
Greg,

It's nothing to do with macros as it reads the Table Catalog. I can read
workbooks with macros and without.

I also have XL2000.

You also need to set a reference to
Microsoft ADOX Ext n.nn for DDL and Security
the file reefrenced in this case will be MSADOX.DLL

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

gpreg said:
Thanks for the function Bob!

But I'm still playing around trying to get this working

I've set references to:
- Microsoft ActiveX Data Object *V2.5* Library
- Microsoft ACtiveX Data Object V2.5 Library

I'm getting the following error message:
Run-time error '-214767259(80004005)':
The Microsoft Jet database engine cannot open the file [filename]. It
is opened exclusively by another user, or you need permission to view
its data.

Is this perhaps because the closed workbook has macros (in the case I'm
currently testing). Opening this world normally involve dealing with
the macro Disable/Enable/cancel dialog so I don't know if this is
perhaps triggering the error?

I guess I should have also mentioned that I'm using Excel 2000.

Thanks again!
Click to expand...
Click to expand...
 
Hi Greg,

Yeah, here's a late binding version

Function IfSheetExists(fName As String, sh As String) As Boolean
Dim objConn As Object
Dim objCat As Object
Dim tbl As Object
Dim iRow As Long
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer

IfSheetExists = False

With ActiveSheet

sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fName & ";" & _
"Extended Properties=Excel 8.0;"

Set objConn = CreateObject("ADODB.Connection")
objConn.Open sConnString
Set objCat = CreateObject("ADOX.Catalog")
Set objCat.ActiveConnection = objConn

iRow = 1
.lstSheetNames.Clear
For Each tbl In objCat.Tables
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
'Worksheet name with embedded spaces are enclosed by single
quotes
If Left(sTableName, 1) = "'" And Right(sTableName, 1) = "'" Then
iTestPos = 1
iStartpos = 2
End If
'Worksheet names always end in the "$" character
If Mid$(sTableName, cLength - iTestPos, 1) = "$" Then
If sh = Mid$(sTableName, iStartpos, cLength - (iStartpos +
iTestPos)) Then
IfSheetExists = True
Exit For
End If
End If
Next tbl
End With

objConn.Close
Set objCat = Nothing
Set objConn = Nothing

End Function


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Here too is a late binding version:
'-----------------------
Function IfSheetExists(fName As String, sh As String) As Boolean
Dim objConn As Object

Set objConn = CreateObject("ADODB.Connection")
objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fName & ";" & _
"Extended Properties=Excel 8.0;"

On Error Resume Next
objConn.Execute "SELECT 1 FROM [" & sh & "$] WHERE 0=1"
IfSheetExists = (Err.Number = 0)

objConn.Close
Set objConn = Nothing

End Function
'------------------------
 
Back
Top