read sheetnames with ADO
 

Hi,

I was wondering wether it's possible to use ADO for retrieving
sheetnames from an excel workbook.

Does anyone know where to find examples?

I'm using VB 6.0 and excel 2003

Help appreciated,


Farmer

read sheetnames with ADO
 

This seems to do the trick. Test it though.

''Needs 2 ADO references
'' - ActiveX Data Objects
'' - ADO Ext for DDL and Security

Sub Demo()
ReadSheetNames "c:\Filename.xls"
End Sub

''Displays sheets names in a closed workbook
Sub ReadSheetNames(TheCompleteFilePath As String)
Dim cnn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table

cnn.Open "Provider=MSDASQL.1;Data Source=" _
& "Excel Files;Initial Catalog=" & TheCompleteFilePath
cat.ActiveConnection = cnn
For Each tbl In cat.Tables
If tbl.Type = "SYSTEM TABLE" Then ''Type "TABLE" seems to return
multicell ranges
Debug.Print Left$(tbl.Name, Len(tbl.Name) - 1)
End If
Next tbl

Set cat = Nothing
cnn.Close
Set cnn = Nothing
End Sub

--
Jim Rech
Excel MVP
"farmer" wrote in message
...
| Hi,
|
| I was wondering wether it's possible to use ADO for retrieving
| sheetnames from an excel workbook.
|
| Does anyone know where to find examples?
|
| I'm using VB 6.0 and excel 2003
|
| Help appreciated,
|
|
| Farmer
|
|

read sheetnames with ADO
 

Farmer,

Here is some code to do it

Sub GetSheetNames()
Dim objConn As Object
Dim objCat As Object
Dim tbl As Object
Dim iRow As Long
Dim sWorkbook As String
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer

sWorkbook = "c:\myTest\bob.xls"
sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sWorkbook & ";" & _
"Extended Properties=Excel 8.0;"

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

iRow = 1
For Each tbl In objCat.Tables
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
'Worksheet name with embedded spaces 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
Cells(iRow, 1) = Mid$(sTableName, iStartpos, cLength - _
(iStartpos + iTestPos))
iRow = iRow + 1
End If
Next tbl
objConn.Close
Set objCat = Nothing
Set objConn = Nothing


End Sub

Jamie Collins also offers this version which uses the Connection object's
OpenSchema method

--

HTH

RP
(remove nothere from the email address if mailing direct)


"farmer" wrote in message
...
Hi,

I was wondering wether it's possible to use ADO for retrieving
sheetnames from an excel workbook.

Does anyone know where to find examples?

I'm using VB 6.0 and excel 2003

Help appreciated,


Farmer

read sheetnames with ADO
 

Jim,

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.

Bob

"Jim Rech" wrote in message
...
This seems to do the trick. Test it though.

''Needs 2 ADO references
'' - ActiveX Data Objects
'' - ADO Ext for DDL and Security

Sub Demo()
ReadSheetNames "c:\Filename.xls"
End Sub

''Displays sheets names in a closed workbook
Sub ReadSheetNames(TheCompleteFilePath As String)
Dim cnn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table

cnn.Open "Provider=MSDASQL.1;Data Source=" _
& "Excel Files;Initial Catalog=" & TheCompleteFilePath
cat.ActiveConnection = cnn
For Each tbl In cat.Tables
If tbl.Type = "SYSTEM TABLE" Then ''Type "TABLE" seems to return
multicell ranges
Debug.Print Left$(tbl.Name, Len(tbl.Name) - 1)
End If
Next tbl

Set cat = Nothing
cnn.Close
Set cnn = Nothing
End Sub

--
Jim Rech
Excel MVP
"farmer" wrote in message
...
| Hi,
|
| I was wondering wether it's possible to use ADO for retrieving
| sheetnames from an excel workbook.
|
| Does anyone know where to find examples?
|
| I'm using VB 6.0 and excel 2003
|
| Help appreciated,
|
|
| Farmer
|
|

read sheetnames with ADO
 

"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.

--

read sheetnames with ADO
 

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

Even an old dog can learn new tricks <vbg

read sheetnames with ADO
 

On Mon, 1 Nov 2004 21:52:47 -0000, "Bob Phillips"
wrote:


Hi,

Thank you all for the explanation and code.


For some reason a small part of the code (Cells(IRow,1) gives an
error, so I changed it


snippet of given code
If Mid$(sTableName, cLength - iTestPos, 1) = "$" Then
Cells(iRow, 1) = Mid$(sTableName, iStartpos, cLength -
(iStartpos + iTestPos))
iRow = iRow + 1
End If

changed it to

If Mid$(sTableName, cLength - iTestPos, 1) = "$" Then
shName = Mid$(sTableName, iStartpos, cLength -
(iStartpos + iTestPos)
End If

List2.AddItem shName


The only strange thing that a worksheetname `sheet1` turns
up as _sheet1_

But I can live with that


Greetings Farmer





Farmer,

Here is some code to do it

Sub GetSheetNames()
Dim objConn As Object
Dim objCat As Object
Dim tbl As Object
Dim iRow As Long
Dim sWorkbook As String
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer

sWorkbook = "c:\myTest\bob.xls"
sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sWorkbook & ";" & _
"Extended Properties=Excel 8.0;"

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

iRow = 1
For Each tbl In objCat.Tables
sTableName = tbl.Name
cLength = Len(sTableName)
iTestPos = 0
iStartpos = 1
'Worksheet name with embedded spaces 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
Cells(iRow, 1) = Mid$(sTableName, iStartpos, cLength - _
(iStartpos + iTestPos))
iRow = iRow + 1
End If
Next tbl
objConn.Close
Set objCat = Nothing
Set objConn = Nothing


End Sub

Jamie Collins also offers this version which uses the Connection object's
OpenSchema method