Getting data from a closed wbook

[RB Smissaert]

That code wasn't tested and indeed it is no good at all, mainly because I
didn't consider the fact
that an array produced by rs.GetArray is transposed.
Shortly after I posted better code (via a phone), but it didn't come
through.
Try this code instead:

Sub test3()

Dim LR As Long

StartSW
LR = GetSheetLastDataRow("C:\ExcelFiles\TestLastRow2003.xls", "Sheet1")
StopSW , "last data row: " & LR & ", done with ADO"

End Sub

Function GetSheetLastDataRow(strWB As String, _
strSheet As String, _
Optional lColumn As Long = -1) As Long

Dim rs As ADODB.Recordset
Dim strConn As String
Dim strSQL As String
Dim arr
Dim LR As Long

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

strSQL = "SELECT * FROM [" & strSheet & "$]"

Set rs = New ADODB.Recordset

rs.Open strSQL, strConn, adOpenStatic, adLockReadOnly, adCmdText
arr = rs.GetRows
GetSheetLastDataRow = GetArrayLastDataRow(arr, lColumn) + 1 'add one as
0-based array

End Function

Function GetArrayLastDataRow(arr As Variant, Optional lColumn As Long = -1)
As Long

'note that the passed array is transposed as it is produced by rs.GetRows
'------------------------------------------------------------------------
Dim r As Long
Dim c As Long
Dim LR As Long
Dim UB As Long
Dim UB2 As Long
Dim LB As Long
Dim LB2 As Long

'note the bounds are reversed due to the supplied array being transposed
'-----------------------------------------------------------------------
UB = UBound(arr, 2)
UB2 = UBound(arr)
LB = LBound(arr, 2)
LB2 = LBound(arr)
GetArrayLastDataRow = LB

'as sheet columns are 1-based, but this array is 0-based
'-------------------------------------------------------
If lColumn > 0 Then
lColumn = lColumn - 1
End If

If lColumn = -1 Then
For c = LB2 To UB2
For r = UB To GetArrayLastDataRow Step -1
If IsNull(arr(c, r)) = False Then
If r > GetArrayLastDataRow Then
GetArrayLastDataRow = r
End If
Exit For
End If
Next r
Next c
Else
For r = UB To GetArrayLastDataRow Step -1
If IsNull(arr(lColumn, r)) = False Then
If r > GetArrayLastDataRow Then
GetArrayLastDataRow = r
End If
Exit For
End If
Next r
End If

End Function


Note here that the final row result is the table row, so the field row is
zero and the first row is row 1.
This means that it is not the same as the sheet row. It works fine with me
and is reasonably quick.


RBS

 

[RB Smissaert]

As mentioned before, this is also an interesting option to consider:
http://www.rondebruin.nl/copy7.htm
One problem seems to be that it doesn't differentiate between empty cells
and
cells holding the value 0.

RBS

 

[Geoff K]

I've been there some time back. AFAIK all it does is download a recordset.

Seems as though I am going to be cursed with this flaw. It's a pity because
my project runs quickly on normal wbks.

Geoff

 

[RB Smissaert]

Did you try the fixed code that works with ADO?

RBS

 

[Geoff K]

Hi

I was just about to post the same thing when I spotted your reply.

It was easy enough to transpose and add 1 for the zero base.

However the ADO function returns me once more to the start position of
mislaigned UsedRanges. On the bloated wbk it returned the last row as 50918
and not the real 98.

I have been here before.

MichDenis in another post some way back now supplied a link
http://cjoint.com/?jDndv2hXXE which uses 2 recordsets. This does avoid the
pitfalls of flawed UsedRanges but is slow.

This is frustrating because the incidence of flawed UsedRanges is only about
2 wbks in 500. But because of the risk, I have to use the slow method on
every wbook. It would be great if I could detect a flawed UsedRange and run
the 2 recordset method on that wbk only. On the rest of the wbks I could use
SELECT COUNT(*) etc.

FWIW I don't believe SELECT COUNT(*) does any counting at all because it is
so blisteringly quick. I think instead it probably uses the UsedRange last
row or something like it. Unfortunately a null is a record to SQL so if the
wbk has been saved with a flawed UsedRange that is what it uses.

So I am right back to square 1. If only I could detect a flawed UsedRange
in a closed wbk………

Geoff

 

[RB Smissaert]

It works fine with me.
Could you mail me that workbook that gives you the wrong answer?

RBS

 

[Geoff K]

I agree, SELECT COUNT(*), RecordCount, GetRows all work fine when the
UsedRange reflects the real data range. Excel4Macros don't work properly
because the code just hangs.

All the above fail to return correct results whenever a wbk has been saved
with a UsedRange flaw. The only method which does work is the 2 recordset I
mentioned earlier but that is very slow.

Unfortunately I am not able to supply the 2 wbks with known UsedRange flaws
because of Data Protection. If they did not contain details of names, jobs,
addresses and telephone numbers you would be very welcome to have a look.
And of course I cannot delete the data as that would reset the UsedRange.

If you can think of a way to create a wbk with an incorrect UsedRange and
employ any of the above methods then you would make the same observations, I
am certain.

Unfortunately I have no control over theses wbks which are supplied from
outside sources. The standard of presentation is appalling - hidden rows,
hidden columns, autofilters, merged cells, wordwraps, end of line characters
- some even without any field names - and of course some with a flawed
UsedRange.

Geoff

 

[RB Smissaert]

hidden rows, hidden columns, autofilters, merged cells, wordwraps, end of

line characters
- some even without any field names

OK, I hadn't tested for all that.
Did you try the latest ADO code I posted?
Can't you produce a demo wb that has (all of) the above problems and make it
fail with ADO code?

RBS

 

[Geoff K]

I mentioned in my first post here that I was looking at using a formula to
include MATCH(99^99 or MATCH("ZZZ" etc The idea is to get a row value for
every field, then get the maximum which will give me the last used row and
original record count.

It coincidently looks similar to Ron de Bruin's code in his Main Program at
the bottom of the page. What is interesting is how he turns formulae into
values. I insert my formula on my hidden Add-in wsheet. But last night I
was getting stuck on how to convert the results into a value - so that
snippet will be useful.

But - even this method fails with the largest UsedRange flaw. The wbk justs
hangs. And even with normal wbks it can be very slow. I have to check all
fields for end of row because required fields are not always in the same
order and I need th get the original count prior to processing.

Geoff

 

[Geoff K]

I agree, SELECT COUNT(*), RecordCount, GetRows all work as expected when the
UsedRange matches the real data.

But all fail with a flawed UsedRange. Excel4Macros failed to run on the
largest of the 2 wbks but not on the smallest.

Unfortunately I have no quality control over these received wbks. Sometimes
the quality is appalling, hidden rows, hidden columns, end of line
characters, merged cells, cell errors, autofilters, some even without field
names and of course some with flawed UsedRanges.

I would be willing to supply the 2 wbks with known flaws were it not for
data protection. They contain names, job titles, telephone numbers etc and
it would be wrong of me to share those details. And of course if I deleted
or overwrote the data the ensuing save would reset the UsedRange.

But if you know of a way to create a UsedRange which is out of line then I
am certain you would make the same observations.

Geoff

 

[Geoff K]

The current project, which uses open wbks, solves all those issues
satisfactorily - even dealing with flawed UsedRanges. What I am trying to do
is extend the current use of ADO and also work from closed wbks. It saves a
great deal of time.

And the beauty of using ADO (from a closed wbk) is that I can ignore having
to undo hidden rows, autofilters etc etc. In one experiment I hid all data
rows and columns, ran the process and it still produced the same final
results as if the wbk had been open BUT as I said a great deal quicker. On
average using ADO on a folder of closed wbks reduces processing time by half.
It is a prize worth pursuing as this application is only part of a wider
process.

Can you produce a flawed UsedRange wbk? I can't.
My only understanding of the phenomenon is they can be caused by "a frequent
change of data area, cutting and pasting" but who knows?

Geoff

 

[RB Smissaert]

I have tried, but not managed to make the ADO method I posted last fail.
If there are no fields at all then it will give one row number less, but
that makes sense, as it
will consider the first row with data the field row. Hiding rows and
columns, merging cells, autofilter and
linebreaks in cells didn't cause any problem. So, not sure what causes the
problem in your wb.

RBS

 

[Geoff K]

I have been able to create a flawed UsedRange wbk! Not sure I can remember
exactly how. < g>

I have run the recent ADO on it and the method does not produce the expected
result.

How can I send the wbk to you? Or, I can try and retrace my steps to
replicate the wbk and pass those on.

Geoff

 

[RB Smissaert]

How can I send the wbk to you?
Just zip it and mail it to me.

RBS

 

[Geoff K]

On the way.

Geoff

Just zip it and mail it to me.

RBS

 

[RB Smissaert]

Do in Excel: Tools, Options, View and tick Zero values and you will see
why it gave you the right answer.

RBS

 

[Geoff K]

I know. If only it were that easy. The wb I sent was not a true flawed
UsedRange.

I thought it was too easy to produce one. I was messing around after the
last post to try and create one and deliberately turned zeros off. In my
enthusiasm I forgot that.

The ADO method doesn't return the expected answer with a true flawed
UsedRange - and there are no hidden zeros either.

I will see if I can do something with the 2 genuine flawed wbks.

Geoff

 

[Geoff K]

Ok I have substituted real data with gobbledy gook in the smaller of the 2
flawed wbks. But it should enable you to see the issue.

I will mail it to you now.

Geoff

 

[Geoff K]

I am now mailing the largest flawed UsedRange wbk.

All real data has been replaced with similar data type.

The UsedRange last cell is AF50918 and the real last cell is S98.

This wbk will not run Excel4 - it just hangs. Execution is considerably
slowed using other methods.

Please let me know how you get on.

Geoff

 

[keiji kounoike]

I don't know whether this one would work or not on your data. But it
seems to be able to detect a flawed UsedRange in my case, ignoring the
time of process. According data, it might be very slow. I assumed a
flawed UsedRange to be data file that returns a wrong number when using
Select count(*) in ADO.


Sub CheckFlawedtest()
Dim SsourceData As String
Dim Table1 As String

SsourceData = "c:\adodata.xls"
Table1 = "[Sheet1$]"

If CkFlawedURange(SsourceData, Table1) Then
MsgBox "Flawed UsedRange"
MsgBox "Corect LastRow Is " & _
GetLastRow(SsourceData, Table1)
Else
MsgBox "Not Flawed"
End If

End Sub

Function CkFlawedURange(ByVal Fname As String, _
ByVal TableName As String) As Boolean
'Fname is a name of a file with a full path
'TableName is a name of Worksheet
Dim oConn As ADODB.Connection
Dim i As Long

Set oConn = New ADODB.Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fname & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Dim oRS As ADODB.Recordset
Set oRS = New ADODB.Recordset

oRS.CursorLocation = adUseClient
oRS.Open TableName, oConn, adOpenStatic
oRS.MoveLast

CkFlawedURange = True
For i = 0 To oRS.Fields.Count - 1
If Not IsNull(oRS.Fields(i).Value) Then
CkFlawedURange = False
Exit For
End If
Next

oRS.Close
oConn.Close
Set oConn = Nothing
Set oRS = Nothing

End Function

Function GetLastRow(ByVal Fname As String, _
ByVal TableName As String) As Long
'Fname is a name of a file with a full path
'TableName is a name of Worksheet
Dim Flawed As Boolean
Dim oConn As ADODB.Connection
Dim i As Long

Set oConn = New ADODB.Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fname & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Dim oRS As ADODB.Recordset
Set oRS = New ADODB.Recordset

oRS.CursorLocation = adUseClient
oRS.Open TableName, oConn, adOpenStatic
oRS.MoveLast

Flawed = True

Do While (Flawed)

For i = 0 To oRS.Fields.Count - 1
If Not IsNull(oRS.Fields(i).Value) Then
Flawed = False
Exit Do
End If
Next
oRS.MovePrevious
Loop

GetLastRow = oRS.AbsolutePosition + 1

oRS.Close
oConn.Close
Set oConn = Nothing
Set oRS = Nothing

End Function

Keiji