count number of sheets in workbook

[Axcell]

Is there a way using VBA to count and report the total number o
worksheets in another closed workbook.

I don't mind briefly opening and closing the workbook to perform th
function. I am attaching the workbook in an email and wanted to includ
the total number of sheets in the body of the email.

Thanks

 

[Frank Kabel]

Hi
try the following

Option Explicit

sub foo()
Dim wbk As Workbook
Dim count_wks
Dim path As String
Dim wbk_filename As String

'Initialization
Application.ScreenUpdating = False
path = "D:\Temp\" 'change this
log_filename = "test.xls" 'change this

'check if other workbook is open / if not open it
On Error Resume Next
Set wbk = Workbooks(wbk_filename)
On Error GoTo 0
If wbk Is Nothing Then
Workbooks.Open filename:=path & wbk_filename
Set wbk = Workbooks(wbk_filename)
End If
msgbox wbk.worksheets.count

' close
Application.DisplayAlerts = False
wbk.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Bob Phillips]

Axcell,

Here is a little fuynction that does it without opening the workbook. Just
call it with the filename as the argument, like

Debug.Print NumSheets("D:\Development\hospital db\TBIcontacts.mdb")

It returns -1 if there is an error, such as non-existant file.



Function NumSheets(FileName As String) As Long
Dim oConn As Object
Dim oCat As Object
Dim oTable As Object
Dim sConnString As String
Dim sFileName As String

sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & FileName & ";"

Set oConn = CreateObject("ADODB.Connection")
On Error Resume Next
oConn.Open sConnString
If Err.Number <> 0 Then
NumSheets = -1
Exit Function
Else
On Error GoTo 0
Set oCat = CreateObject("ADOX.Catalog")
Set oCat.ActiveConnection = oConn

NumSheets = oCat.tables.Count
End If

oConn.Close
Set oCat = Nothing
Set oConn = Nothing

End Function




--

HTH

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

 

[Bob Phillips]

Little faux-pas in there, it used an Access connection string.

Here is a corrected version that access Excel spreadsheets. Otherwise it is
the same.

I have also included an ADO version just to show the difference.

'---------------------------------------------------------------------------
---------
' ADOX Version
'---------------------------------------------------------------------------
---------
Function NumSheetsADOX(FileName As String) As Long
Dim oConn As Object
Dim oCat As Object
Dim oTable As Object
Dim sConnString As String
Dim sFileName As String

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

Set oConn = CreateObject("ADODB.Connection")
On Error Resume Next
oConn.Open sConnString
If Err.Number <> 0 Then
NumSheetsADOX = -1
Exit Function
Else
On Error GoTo 0
Set oCat = CreateObject("ADOX.Catalog")
Set oCat.ActiveConnection = oConn

NumSheetsADOX = oCat.tables.Count
End If

oConn.Close
Set oCat = Nothing
Set oConn = Nothing

End Function

'---------------------------------------------------------------------------
---------
' ADO Version
'---------------------------------------------------------------------------
---------
Function NumSheetsADO(FileName As String) As Long
Dim oConn As Object
Dim oRS As Object
Dim sConnString As String
Dim sFileName As String
Dim cTables As Long

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

Set oConn = CreateObject("ADODB.Connection")
On Error Resume Next
oConn.Open sConnString
If Err.Number <> 0 Then
NumSheetsADO = -1
Exit Function
Else
On Error GoTo 0
Set oRS = oConn.OpenSchema(20, _
Array(Empty, Empty, Empty, "Table"))
Do While Not oRS.EOF
cTables = cTables + 1
oRS.MoveNext
Loop
End If
NumSheetsADO = cTables

oConn.Close
Set oRS = Nothing
Set oConn = Nothing

End Function



--

HTH

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

 

[Axcell]

Thanks guys, I went with Frank's suggestion and it works great.

Bob, I appreciate the ADO code. It is still a little intimidating to m
right now. Eventually, when I clean up the code when I finish m
project, I will be interested in your approach.

Thanks for the replies