Getting data from a closed wbook
in [Programming]
|
Prev: Counting records with ADO
Next: Microsoft.Office.Interop.Excel myexcel = new EXCEL.Application()
From: RB Smissaert on 4 Oct 2009 19:00 Do in Excel: Tools, Options, View and tick Zero values and you will see why it gave you the right answer. RBS "Geoff K" <GeoffK(a)discussions.microsoft.com> wrote in message news:E4A5976B-7762-443A-A4BA-6368B805330F(a)microsoft.com... > On the way. > > Geoff > > "RB Smissaert" wrote: > >> > How can I send the wbk to you? >> Just zip it and mail it to me. >> >> RBS >> >> "Geoff K" <GeoffK(a)discussions.microsoft.com> wrote in message >> news:2098D600-0807-4CCA-877C-6E03BCC66A7B(a)microsoft.com... >> >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" wrote: >> > >> >> 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" <GeoffK(a)discussions.microsoft.com> wrote in message >> >> news:A3DB79C2-BCE2-4671-93D4-ED751885C819(a)microsoft.com... >> >> >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 >> >> > >> >> > "RB Smissaert" wrote: >> >> > >> >> >> Did you try the fixed code that works with ADO? >> >> >> >> >> >> RBS >> >> > >> >> >> >> >> >>
From: Geoff K on 4 Oct 2009 19:19 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 "RB Smissaert" wrote: > Do in Excel: Tools, Options, View and tick Zero values and you will see > why it gave you the right answer. > > RBS
From: keiji kounoike "kounoike A | T on 5 Oct 2009 03:39 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: >
From: Geoff K on 5 Oct 2009 10:53 Hi My grateful thanks - the GetArrayLastDataRow method works now, UsedRange flaws or not. <g> Excellent stuff. For the avoidance of doubt due to the number of varaitions I think it might be useful to others perhaps if you were to post the finished code?. However one thing remains - wsheet names: Because wbks are closed I do not know the sheet name and your solution uses "Sheet1" in the SQL but names are changed from the default albeit occasionally. I trap this error currently but it would be good to have avoid this issue. I've recently been evaluating the conversion of my application to Delphi and noted it has a very useful function called "GetTableNames". This will read wsheet names and easily overcomes the renaming of sheets issue as far as the SQL query is concerned. Are you aware of a way to do this in VBA? Geoff "Geoff K" wrote: > 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
From: Bart Smissaert on 5 Oct 2009 11:04
On Oct 5, 3:53 pm, Geoff K <Geo...(a)discussions.microsoft.com> wrote: > Hi > > My grateful thanks - the GetArrayLastDataRow method works now, UsedRange > flaws or not. <g> Excellent stuff. > > For the avoidance of doubt due to the number of varaitions I think it might > be useful to others perhaps if you were to post the finished code?. > > However one thing remains - wsheet names: > Because wbks are closed I do not know the sheet name and your solution uses > "Sheet1" in the SQL but names are changed from the default albeit > occasionally. > > I trap this error currently but it would be good to have avoid this issue.. > > I've recently been evaluating the conversion of my application to Delphi and > noted it has a very useful function called "GetTableNames". This will read > wsheet names and easily overcomes the renaming of sheets issue as far as the > SQL query is concerned. > > Are you aware of a way to do this in VBA? > > Geoff > > "Geoff K" wrote: > > 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 Here is a neat way to get the sheet names of a closed workbook. Closed is relevant here as obviously it can be done in a much simpler way if the wb is open. Note that this code works on the BIFF Excel file data, so it is very fast. Sub TestGetWBSheetNames() Dim arr arr = GetWBSheetNames("C:\Test.xls") Range(Cells(1), Cells(UBound(arr), 2)) = arr End Sub Function GetWBSheetNames(sFullName As String, _ Optional bWorksheetsOnly As Boolean = False, _ Optional bSheetTypeAsString As Boolean = True) As Variant '-------------------------------------------------------------------- 'Returns a 1-based 2-D array 'showing the sheet names in column 1 of the array 'and the sheet type in column 2 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 i As Long 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 Dim arr Const IDboundsheet = &H85 '133 Const BuffSize = &H400 '1024 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 'transfer the collection to an array '----------------------------------- ReDim arr(1 To cRes.Count, 1 To 2) For i = 1 To cRes.Count arr(i, 1) = cRes.Item(i)(0) arr(i, 2) = cRes.Item(i)(1) Next i GetWBSheetNames = arr End Function RBS "Geoff K" <GeoffK(a)discussions |