Is it possible to...WITHOUT OPENING EACH WORKBOOK?

[Guest]

Find out all sheetnames for each workbook in a folder WITHOUT OPENING EACH
WORKBOOK? (I'd like to have them in a column on my worksheet for further
processing.)

Similarly, can I copy data from one workbook to another (or for that matter
from within a workbook) WITHOUT OPENING EACH WORKBOOK?

I ask cause the opening and closing seems to take up rather a lot of time...

Many thanks for your answers.

Regards,
JVLIN

 

[Bob Phillips]

You could using ADOX, but there is a performance overhead there as well.
IMO, it is simpler to just open them, get your data, then close them, one at
a time.

 

[keepITcool]

opening could trigger recalcs and recompiles ..,
maybe adox wouldnt be that bad..

Following is a starter for the ADOX way...
collects all books with sheets from current directory

around 2 seconds on 75 mostly smaller files...
and may bug out on protected workbooks..
not fully tested..


Function BooksAndSheets() As Collection

Dim col As Collection
Dim fil As String
Dim i As Integer
Dim cat As Object

Set cat = CreateObject("ADOX.Catalog")
Set BooksAndSheets = New Collection

fil = Dir$("*.xls")

While fil <> vbNullString
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Extended Properties=""Excel 8.0"";Data Source=" & fil & ";"
Set col = New Collection
For i = 0 To cat.Tables.Count - 1
col.Add Array(fil, Replace(cat.Tables(i).Name, "$", vbNullString))
Next
BooksAndSheets.Add col, fil
fil = Dir$()
Wend
cat.ActiveConnection.Close
Set cat = Nothing

End Function




keepITcool

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

 

[Bob Phillips]

Calculation could be turned off. I still maintain in this case, opening and
closing seems more straightforward.

 

[keepITcool]

Same code for workbooks takes 5 times longer then ADOX!
<2secs vs 10-12 secs on an average testdir with 75 assorted files


(The code is MORE complex than ADOX
I think I've disabled most of the settings that might slow it down
and if VBE is visible it's LOTS worse


Function BookandSheet() As Collection
Dim col As Collection
Dim fil As String
Dim i As Integer
Dim state&(3)
Dim t!
t = Timer * 1000

With Application
state(0) = .Calculation
.Calculation = xlCalculationManual
state(1) = .EnableEvents
.EnableEvents = False
state(2) = .ScreenUpdating
.ScreenUpdating = False
state(3) = .VBE.MainWindow.Visible
.VBE.MainWindow.Visible = False
End With

Set BookandSheet = New Collection
fil = Dir$("*.xls")

While fil <> vbNullString
Set col = New Collection
With Workbooks.Open(fil, False, True, addtomru:=False)
For i = 0 To .Sheets.Count
col.Add .Sheets(1).Name
Next
.Close (0)
End With
BookandSheet.Add col, fil
fil = Dir$()
Wend

With Application
..Calculation = state(0)
..EnableEvents = state(1)
..ScreenUpdating = state(2)
..VBE.MainWindow.Visible = state(3)
End With

MsgBox CLng(Timer * 1000 - t) & "msecs"
Stop

End Function


keepITcool

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

 

[Bob Phillips]

I didn't say faster, I said more straightforward, and I think in the light
of Jamie's response, I still stick by that.

 

[keepITcool]

Jamie !

I agree that Openschema might be better and has less overhead then adox.

Note we can't use SYSTEM TABLE.
'KB300948 : BUG: Incorrect TABLE_TYPE Is Returned for Excel Worksheets

I tested the recommended workaround in the KB, using dsnless ODBC.
However IF a sheet name has spaces or $, the ODBC dirver returns a
Table_Type of TABLE iso SYSTEM_TABLE. so we'd need a different
workaround again.


I DID ifnd your code a bit longwinded.. so I trimmed it down a bit <g>
Personally I prefer using a collection for these functions.
(sheet count will be <500 so only small performance loss, but easier
handling.

using the LIKE operator like this seems to work correctly, although I
didnt do exhaustive testing.


Public Function GetWSNames(ByVal WBPath As String) As Collection
Dim sTmp$

Set GetWSNames = New Collection

With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Extended Properties='Excel 8.0;HDR=Yes';" & _
"Data Source=" & WBPath & ";"

With .OpenSchema(20)
While Not .EOF
If !Table_Name Like "*[$']" Then
sTmp = Replace(!Table_Name, "'", "")
sTmp = Left(sTmp, Len(sTmp) - 1)
GetWSNames.Add sTmp,sTmp
End If
.MoveNext
Wend
.Close
End With

.Close
End With

End Function


keepITcool

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

opening could trigger recalcs and recompiles maybe adox wouldnt be
that bad..
Agreed.

Following is a starter for the ADOX way
collects all books with sheets from current directory not fully
tested..

Noted. You have fallen foul of the usual gotchas <g> :

1) The $ character, in common with the single quote ' character, is
legal in a worksheet name e.g. in my Excel test database workbook I
have the following worksheet names as 'seen' by Jet:

'Sheet Name Has $ dollar and gap$'
' ''$$'
'$$'

2) Worksheet-level defined Names appear as Excel tables and the $ is
used as a delimiter between sheet name and Name name ($ is illegal in
Name names) e.g. in my database I have the following sheet-level
names:

EarningsHistory$Table1
'Sheet Name Has $ dollar and gap$'MyName
' ''$$'MyName

So your code returns items that aren't worksheets and changes the
names of some worksheets <g>.

Here's my attempt (again, not fully tested):

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.

--

 

[Guest]

F ME !

I don't recognize any of the code. I will try and run it though, but last
time I asked a question in the programming section for a while.

j

 

[Jamie Collins]

Gents, We seem to overlooked the OP's other question:

can I copy data from one workbook to another (or for that matter
from within a workbook) WITHOUT OPENING EACH WORKBOOK?

If your data is arranged as a database (i.e. rows of columns,
preferable with column headers) then yes.

A simple example to copy the entire contents of one table (worksheet)
to another workbook where the table does not already exist:

SELECT
MyKeyCol, MyDataCol
INTO
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MyTargetWorkbook.xls;].[Sheet8$]
FROM
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MySourceWorkbook.xls;].[Sheet8$]
;

A more complex example where the table does already exist in the
target workbook and you only want to append non-duplicated rows:

INSERT INTO
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MyTargetWorkbook.xls;].[Sheet8$]
(MyKeyCol, MyDataCol)
SELECT
T1.MyKeyCol, T1.MyDataCol
FROM
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MySourceWorkbook.xls;].[Sheet8$] T1
LEFT JOIN
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MyTargetWorkbook.xls;].[Sheet8$] T2
ON T1.MyKeyCol=T2.MyKeyCol
WHERE
T2.MyKeyCol IS NULL
;

Jamie.

--

 

[Guest]

Thanks for this.

I have a lot on my plate and won't get round to implementing this code for a
while.

I will let you know it worked though.

Regards,

JVLin

Gents, We seem to overlooked the OP's other question:

can I copy data from one workbook to another (or for that matter
from within a workbook) WITHOUT OPENING EACH WORKBOOK?

If your data is arranged as a database (i.e. rows of columns,
preferable with column headers) then yes.

A simple example to copy the entire contents of one table (worksheet)
to another workbook where the table does not already exist:

SELECT
MyKeyCol, MyDataCol
INTO
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MyTargetWorkbook.xls;].[Sheet8$]
FROM
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MySourceWorkbook.xls;].[Sheet8$]
;

A more complex example where the table does already exist in the
target workbook and you only want to append non-duplicated rows:

INSERT INTO
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MyTargetWorkbook.xls;].[Sheet8$]
(MyKeyCol, MyDataCol)
SELECT
T1.MyKeyCol, T1.MyDataCol
FROM
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MySourceWorkbook.xls;].[Sheet8$] T1
LEFT JOIN
[Excel 8.0;HDR=YES;Database=C:\My
Folder\MyTargetWorkbook.xls;].[Sheet8$] T2
ON T1.MyKeyCol=T2.MyKeyCol
WHERE
T2.MyKeyCol IS NULL
;

Jamie.