KeepITCool,

I have worked your function a bit further out and as other people may find
this useful I post it here.
I am sure you won't mind.

Function ReadSheets(sFullName As String, _
Optional bWorksheetsOnly As Boolean = False, _
Optional bSheetTypeAsString As Boolean = True) As
Collection

'from a newsgroup posting by KeepITCool
'--------------------------------------------------------------------
'Returns a collection of 0-based one-dimensional arrays
'showing the sheet names in element 0 of the array
'and the sheet type in element 1 of the array
'0 = WorkSheet (dialog sheet will be 0 as well)
'2 = ChartSheet
'if bWorksheetsOnly = True it will only look at worksheets
'if bSheetTypeAsString = True it will show the sheet type as a string
'--------------------------------------------------------------------

Dim aByt() As Byte
Dim iTyp As Integer
Dim lHnd As Long
Dim lLen As Long
Dim lPos1 As Long
Dim lPos2 As Long
Dim sTxt As String
Dim sTyp As String
Dim cRes As Collection

Const IDboundsheet = &H85 '133
Const BuffSize = &H400 '1024

If Dir(sFullName) = vbNullString Then
Exit Function
End If

Set cRes = New Collection
ReDim aByt(0 To BuffSize)

lLen = FileLen(sFullName)
lHnd = FreeFile

Open sFullName For Binary Access Read As lHnd Len = BuffSize

Do
lPos1 = lPos1 + BuffSize - 1
Get lHnd, lPos1, aByt
lPos2 = InStrB(aByt, ChrB(IDboundsheet))
Loop While lPos2 = 0 And lPos1 < lLen

Do While lPos2 0
lPos1 = lPos1 + lPos2 - 1
Get lHnd, lPos1, aByt
sTxt = Mid(StrConv(aByt, vbUnicode), 13, aByt(10))
iTyp = aByt(9)

If bSheetTypeAsString = True Then
If iTyp = 0 Then
sTyp = "WorkSheet"
Else
sTyp = "ChartSheet"
End If
If bWorksheetsOnly = True Then
If iTyp = 0 Then
cRes.Add Array(sTxt, sTyp), sTxt
End If
Else
cRes.Add Array(sTxt, sTyp), sTxt
End If
Else
If bWorksheetsOnly = True Then
If iTyp = 0 Then
cRes.Add Array(sTxt, iTyp), sTxt
End If
Else
cRes.Add Array(sTxt, iTyp), sTxt
End If
End If

If aByt(aByt(2) + 4) < IDboundsheet Then
lPos2 = 0
Else
lPos2 = InStrB(4, aByt, ChrB(&H85))
End If
Loop

Close lHnd
Set ReadSheets = cRes

End Function


Sub TestReadSheets()

Dim arr
Dim c As Byte
Dim i As Long
Dim col As Collection

Set col = ReadSheets("C:\ExcelFiles\Test.xls")

For i = 1 To col.Count
arr = col.Item(i)
For c = 0 To 1
Cells(i, c + 1) = arr(c)
Next
Next

End Sub


RBS



"keepITcool" wrote in message
...

Hi guys

ADO (Jet) needs Sheet Names and cannot use indexes. (Since tables in
databases would have no 'ordinal' position)

To give myself a bit (or byte) of flexibility I'm trying to come up with a
little structure reader for closed files. I've got a nice simple
routine... Problem is it will recognize a DialogSheet as a Worksheet

To be precise it returns a 0 (worksheet) in byte 9 of the BoundsSheet
record...

So I assume I've got to jump to the stream itself.. but I haven;t figured
out how (yet) I presume I must use the Long at offset 4 in the record as
my target address?

Anyone any ideas? (or working code?)
My code below.. Now a bad start as is :)


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


Function ReadSheets(sFullName As String, _
Optional bWorksheetsOnly As Boolean = True) As Collection
'Returns a collection of the sheets in a workbook.

Dim lHnd&, lLen&, lPos&, aByt() As Byte, cRes As Collection
Dim iPos&, iTyp%, sTxt$

Const IDboundsheet = &H85
Const BuffSize = &H400

If Dir(sFullName) = vbNullString Then Exit Function

Set cRes = New Collection
ReDim aByt(0 To BuffSize)
lLen = FileLen(sFullName)
lHnd = FreeFile

Open sFullName For Binary Access Read As #lHnd Len = BuffSize

Do
lPos = lPos + BuffSize - 1
Get #lHnd, lPos, aByt
iPos = InStrB(aByt, ChrB(IDboundsheet))
Loop While iPos = 0 And lPos < lLen

Do While iPos 0
lPos = lPos + iPos - 1
Get #lHnd, lPos, aByt
sTxt = Mid(StrConv(aByt, vbUnicode), 13, aByt(10))
iTyp = aByt(9)

cRes.Add Array(sTxt, iTyp), sTxt
If aByt(aByt(2) + 4) < IDboundsheet Then
iPos = 0
Else
iPos = InStrB(4, aByt, ChrB(&H85))
End If
Loop

Close #lHnd
Set ReadSheets = cRes

End Function