View Single Post
  #40   Report Post  
Posted to microsoft.public.excel.programming
keiji kounoike keiji kounoike is offline
external usenet poster
 
Posts: 199
Default Getting data from a closed wbook

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

Geoff K wrote:
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" wrote:

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: