Counting records with ADO
in [Programming]
|
From: Geoff K on 29 Sep 2009 03:55 Hi michdenis I get an error at Rst1.Find X X returns a value in Field 0. Whilst Rst.MoveLast is used I am not able to verify that is working as I believe is intended because that field contains records which coincidently are all the same so I'm not able to tell if X is the first or last record. (I do not want to change wbook values for testing as that will reset the out of line UsedRange) Geoff "michdenis" wrote: > Hi Geoff, > > Have you tested this ? Using 2 recordsets > > '-------------------------------------------- > Sub test() > Dim Conn As ADODB.Connection > Dim Rst As New ADODB.Recordset > Dim Rst1 As New ADODB.Recordset > Dim SheetName As String > Dim MyField As String > Dim Query As String, Query1 As String > Dim X As String > Dim Z As Long > > SheetName = "Sheet1" > MyField = "ItsName" ' to determine > > Set Conn = New ADODB.Connection > Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ > "Data Source=" & ThisWorkbook.FullName & ";" & _ > "Extended Properties=""Excel 8.0;HDR=Yes;""" > > Query = "SELECT * FROM [" & SheetName & "$]" & _ > " Where Not IsNull(" & MyField & ")" > > Query1 = "SELECT * FROM [" & SheetName & "$]" > > Rst.Open Query, Conn, adOpenStatic, adLockReadOnly > Rst1.Open Query1, Conn, adOpenStatic, adLockReadOnly > > Rst.MoveLast > 'I supposed a numeric field... > X = "" & MyField & "=" & Rst(0).Value > > 'Need a loop if duplicate in the field > Do While Rst1.EOF = False > Rst1.Find X > Z = Rst1.AbsolutePosition > Rst1.MoveNext > Loop > MsgBox "Last row of " & MyField & " is : " & Z + 1 > Rst.Close: Rst1.Close > Conn.Close > Set Rst = Nothing: Set Rst1 = Nothing > Set Conn = Nothing > > End Sub > '-------------------------------------------- > > Bye !
From: michdenis on 29 Sep 2009 07:05 There is an exemple in this file : http://cjoint.com/?jDndv2hXXE "Geoff K" <GeoffK(a)discussions.microsoft.com> a écrit dans le message de groupe de discussion : 159C0375-26F9-4A14-9B08-9175300907F9(a)microsoft.com... Hi michdenis I get an error at Rst1.Find X X returns a value in Field 0. Whilst Rst.MoveLast is used I am not able to verify that is working as I believe is intended because that field contains records which coincidently are all the same so I'm not able to tell if X is the first or last record. (I do not want to change wbook values for testing as that will reset the out of line UsedRange) Geoff "michdenis" wrote: > Hi Geoff, > > Have you tested this ? Using 2 recordsets > > '-------------------------------------------- > Sub test() > Dim Conn As ADODB.Connection > Dim Rst As New ADODB.Recordset > Dim Rst1 As New ADODB.Recordset > Dim SheetName As String > Dim MyField As String > Dim Query As String, Query1 As String > Dim X As String > Dim Z As Long > > SheetName = "Sheet1" > MyField = "ItsName" ' to determine > > Set Conn = New ADODB.Connection > Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ > "Data Source=" & ThisWorkbook.FullName & ";" & _ > "Extended Properties=""Excel 8.0;HDR=Yes;""" > > Query = "SELECT * FROM [" & SheetName & "$]" & _ > " Where Not IsNull(" & MyField & ")" > > Query1 = "SELECT * FROM [" & SheetName & "$]" > > Rst.Open Query, Conn, adOpenStatic, adLockReadOnly > Rst1.Open Query1, Conn, adOpenStatic, adLockReadOnly > > Rst.MoveLast > 'I supposed a numeric field... > X = "" & MyField & "=" & Rst(0).Value > > 'Need a loop if duplicate in the field > Do While Rst1.EOF = False > Rst1.Find X > Z = Rst1.AbsolutePosition > Rst1.MoveNext > Loop > MsgBox "Last row of " & MyField & " is : " & Z + 1 > Rst.Close: Rst1.Close > Conn.Close > Set Rst = Nothing: Set Rst1 = Nothing > Set Conn = Nothing > > End Sub > '-------------------------------------------- > > Bye !
From: Geoff K on 30 Sep 2009 03:23 Hi Keiji I already have an algorthm which works very well on open workbooks. I am attempting to save running time by NOT opening wbooks. Geoff "keiji kounoike" <"kounoike A | T ma.Pik" wrote: > Hi Geoff > > I'm not sure that I've understood your situation correctly. And you > might not want to have this one because this one also needs to open a > file. but what if getting the last row before applying your macro? the > code is like this. > > Sub Getlastrow_Workbook() > Dim oAPP As Object > Dim WK As Workbook > Dim SourceFile As String > Dim shname As String > > SourceFile = "C:\adodata.xls" > shname = "Sheet1" > > Set oAPP = CreateObject("Excel.Application") > oAPP.Visible = False > Set WK = oAPP.Workbooks.Open(SourceFile) > lastrow = WK.Worksheets(shname).Cells.Find(What:="*", _ > After:=WK.Worksheets(shname).Range("A1"), _ > SearchOrder:=xlByRows, _ > SearchDirection:=xlPrevious).Row > oAPP.DisplayAlerts = False > WK.Close > MsgBox lastrow > Set oAPP = Nothing > End Sub > > Keiji > > Geoff K wrote: > > Hi Keiji > > In my existing project I only use Query1 on unopened wbooks to determine if > > they have the required fields. But once that is done I open each one for > > processing. Part of the process is resetting the UsedRange, unhiding hidden > > rows or columns, undoing any AutoFilter which may have been saved, undoing > > any WordWraps, deleting end of line characters, terminating wbook links or > > HyperLinks and other things before commencing the real task of extracting > > required fields. > > > > On that basis a folder of say 50 wbooks, each with an average of 1,000 rows > > will take around 45 seconds to extract around 45,000 coherent rows. > > > > With my wish-for algorithm of not opening any wbooks, the time is reduced to > > around 20 seconds. Because this application needs to be run as often as it > > does during the day and it is only part of a wider application you can > > perhaps appreciate why it is worthwhile pursuing the option. > > > > It is a real shame that wbooks are affected this way by a flawed UsedRange. > > ADO and SQL are great, I can even read data when all data rows and columns > > have been hidden! On an open wbook that would be impossible without > > unhiding. I meet this misalignment of UsedRange in only 1 wbook out of 300 > > but when it does occur it has to be dealt with correctly. > > > > Unfortunately after research and experimenting it now appears impossible to > > reliably get a correct record count with either RecordCount or Count(*) when > > the wbook is closed. > > > > But thank you again for your help and participation. > > > > Regards > > > > Geoff > > > > > > "keiji kounoike" <"kounoike A | T ma.Pik" wrote: > > > >> Hi Geoff > >> > >> I've came to understand what you pointed. you are right about Usedrange > >> problem. I think this is not your option, but how about to reset > >> UsedRange before you run your macro. then, i think count(*) could return > >> a correct number. But To reset UsedRange, you need to open your data > >> file, so I think this is not the way you could accept. > >> > >> Keiji > >> > >> Geoff K wrote: > >>> Hi Keiji > >>> It is not easy to create a wbook where the UsedRange is out of line then > >>> save it. I have the advantage (or not) in being able to work with 3 examples > >>> sourced externally. It may be you are not able to replicate my problem > >>> because you do not have a misaligned wbook to hand? > >>> > >>> As to the issue I have with counting records - I have been able to count > >>> both non-nulls and nulls in the wsheet. As I expected when the 2 counts are > >>> summed the total is 50917 not 97 as I want. > >>> > >>> First - Count(*). I don't beleive it actually counts anything. It gets > >>> instead the UsedRange last row address and then makes an adjustment depending > >>> on whether HDR is set as yes or no in the connection string. > >>> > >>> Please see this MS response to a similar question > >>> http://www.pcreview.co.uk/forums/thread-3284796.php > >>> > >>> Second - RecordCount. In counting nulls or non-nulls it will will count to > >>> EOF and that means the last record which in this case is at row 50918. > >>> > >>> So at the moment I do not see any way of arriving at the correct record > >>> count of 97 whern UsedRange is mis-aligned. Remember the objective is to > >>> leave wbooks closed. It appears therefore that unless the UsedRange is > >>> aligned with the real last cell there is no way a true count can ever be > >>> obtained with these methods. > >>> > >>> But I would love to be proved wrong. :) > >>> > >>> Geoff > >>> > >>> "keiji kounoike" <"kounoike A | T ma.Pik" wrote: > >>> > >>>> Hi Geoff > >>>> > >>>> I set the reference to some library in my macro. but using your macros, > >>>> I can't replicate your problem. First i put data into IV63556, then i > >>>> run the macro main below, it returns like this > >>>> > >>>> SELECT COUNT(*) FROM [Sheet1$A1:IU65536]; 65535 1 > >>>> SELECT * FROM [Sheet1$A1:IU65536]; a 65535 > >>>> > >>>> after this, I delete data in IV63556 and run the macro main, i get the > >>>> result like this > >>>> > >>>> SELECT COUNT(*) FROM [Sheet1$A1:IU65536]; 33 1 > >>>> SELECT * FROM [Sheet1$A1:IU65536]; a 33 > >>>> > >>>> I think you can't get a correct number of data with using RecordsCount > >>>> after having executed SELECT COUNT(*) FROM... > >>>> It always returns 1. > >>>> > >>>> I added some lines in your code and run main. the result was like above. > >>>> > >>>> Sub main() > >>>> > >>>> GetData "c:\adodata.xls", "Sheet1$A1:IU65536", Range("a1") > >>>> > >>>> End Sub > >>>> > >>>> > >>>> Public Sub GetData(SourceFile As Variant, SourceRange As String, > >>>> TargetRange As Range) > >>>> > >>>> Dim rsCon As Object > >>>> Dim rsData2 As Object > >>>> Dim szConnect As String > >>>> Dim szSQL2 As String > >>>> Dim rsCount2 As Variant > >>>> Dim rsCount3 As Long > >>>> > >>>> szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ > >>>> "Data Source=" & SourceFile & ";" & _ > >>>> "Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1;"";" > >>>> > >>>> Set rsCon = CreateObject("ADODB.Connection") > >>>> Set rsData2 = CreateObject("ADODB.Recordset") > >>>> rsCon.Open szConnect > >>>> > >>>> szSQL2 = "SELECT COUNT(*) FROM [" & SourceRange$ & "];" > >>>> rsData2.Open szSQL2, rsCon, adOpenStatic > >>>> rsCount2 = rsData2(0) > >>>> rsCount3 = rsData2.RecordCount > >>>> Debug.Print szSQL2; vbTab; rsCount2; vbTab; rsCount3 > >>>> > >>>> > >>>> 'Added these 6 lines from here > >>>> rsData2.Close > >>>> szSQL2 = "SELECT * FROM [" & SourceRange$ & "];" > >>>> rsData2.Open szSQL2, rsCon, adOpenStatic > >>>> rsCount2 = rsData2(0) > >>>> rsCount3 = rsData2.RecordCount > >>>> Debug.Print szSQL2; vbTab; rsCount2; vbTab; rsCount3 > >>>> > >>>> If rsData2.State = adStateOpen Then rsData2.Close > >>>> Set rsData2 = Nothing > >>>> rsCon.Close > >>>> Set rsCon = Nothing > >>>> > >>>> End Sub > >>>> > >>>> Keiji > >>>> > >>>> Geoff K wrote: > >>>>> Hi Keiji > >>>>> > >>>>> Thank you for your responses so far. > >>>>> > >>>>> FWIW please note in my first post the example 3 field table came out wrongly > >>>>> formatted when posted. It was meant to show 2 records beneath each of the 3 > >>>>> fields but turned out as 6 under Field1. > >>>>> > >>>>> I note your code requires references to ADODB whereas I use CreateObject. > >>>>> Can I ask what you are using? > >>>>> > >>>>> The wbook in question shows: > >>>>> UsedRange last cell = AF50918 > >>>>> Real last cell = S98 > >>>>> > >>>>> I use szSQL1 to read and download field names to a temp wsheet using > >>>>> szSQL1 = "SELECT * FROM [" & SourceRange$ & "];" > >>>>> In this initial query SourceRange is defined as A1:IU1. Note IU and not > >>>>> IV1. This overcomes the error 'Too many fields defined' which I have also > >>>>> come across in some wbooks. Whilst not perfect I have never known all fields > >>>>> to be used in any wbook so I have 'got away' with it so far. > >>>>> > >>>>> Therefore from szSQL1 I know the real last field is in column S and I also > >>>>> know if the wbook contains the required fields. I can then redefine > >>>>> SourceRange in szSQL2 for this wbook as A1:S65536 > >>>>> > >>>>> Turning now to your suggestion, Debug returns > >>>>> szSQL2 = SELECT COUNT(*) FROM [A1:S65536] > >>>>> rsCount2 = rsData2(0) returns 50917 > >>>>> rsCount3 = rsData2.RecordCount returns 1 > >>>>> > >>>>> It does not seem to matter whether I use Sheet1$ or the defined range. > >>>>> > >>>>> Start code: > >>>>> Public Sub GetData(SourceFile As Variant, SourceRange As String, TargetRange > >>>>> As Range) > >>>>> > >>>>> Dim rsCon As Object > >>>>> Dim rsData2 As Object > >>>>> Dim szConnect As String > >>>>> Dim szSQL2 As String > >>>>> Dim rsCount2 As Long > >>>>> Dim rsCount3 As Long > >>>>> > >>>>> szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ > >>>>> "Data Source=" & SourceFile & ";" & _ > >>>>> "Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1;"";" > >>>>> > >>>>> Set rsCon = CreateObject("ADODB.Connection") > >>>>> Set rsData2 = CreateObject("ADODB.Recordset") > >>>>> rsCon.Open szConnect > >>>>> > >>>>> szSQL2 = "SELECT COUNT(*) FROM [" & SourceRange$ & "];" > >>>>> rsData2.Open szSQL2, rsCon, adOpenStatic > >>>>> rsCount2 = rsData2(0) > >>>>> rsCount3 = rsData2.RecordCount > >>>>> > >>>>> Debug.Print szSQL2; vbTab; rsCount2; vbTab; rsCount3 > >>>>> > >>>>> If rsData2.State = adStateOpen Then rsData2.Close > >>>>> Set rsData2 = Nothing > >>>>> rsCon.Close > >>>>> Set rsCon = Nothing > >>>>> > >>>>> End Sub > >>>>> End code > >>>>> > >>>>> Geoff > >>>>> > >>>>> > >>>>> "keiji kounoike" <"kounoike A | T ma.Pik" wrote: > >>>>> > >>>>>> Hi Geoff > >>>>>> > >>>>>> Give this one a try. This would give you the last row of data in the > >>>>>> whole Worksheet. To be more accurate, the last row of data minus 1 > >>>>>> because this assumes the first row is a header. > >>>>>> > >>>>>> Sub ADOtest() > >>>>>> Dim oConn As ADODB.Connection > >>>>>> Dim Table1 As String > >>>>>> Dim Query2 As String > >>>>>> > >>>>>> sSourceData = "c:\adodata.xls" '<<==Change to Your file's name > >>>>>> Table1 = "[Sheet1$]" '<<==Change to sheet's name plus "$" > >>>>>> Query2 = "Select * from " & Table1 > >>>>>> > >>>>>> Set oConn = New ADODB.Connection > >>>>>> oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ > >>>>>> "Data Source=" & sSourceData & ";" & _ > >>>>>> "Extended Properties=""Excel 8.0;HDR=YES;""" > >>>>>> > >>>>>> Dim oRS As ADODB.Recordset > >>>>>> Set oRS = New ADODB.Recordset > >>>>>> oRS.Open Query2, oConn, adOpenStatic > >>>>>> MsgBox oRS.RecordCount > >>>>>> > >>>>>> End Sub > >>>>>> > >>>>>> Keiji > >>>>>> > >>>>>> Geoff K wrote: > >>>>>>> Hi Keiji > >>>>>>> Table1 is just an example name. In reality it represents the field name > >>>>>>> range which varies from 1 wbook to another. Wbook1 could be "A1:T65536" > >>>>>>> Wbook2 "A1:AM65536". > >>>>>>> So SELECT [Fax] FROM [A1:AJ65536$]. "Fax" might be in "D1" or "Z1" or "N1". > >>>>>>> > >>>>>>> I would like to find the last row of data in the whole wsheet but UsedRange > >>>>>>> can sometimes stop me doing that accurately. My next thought was I can > >>>>>>> easily count the data records in Fax with SELECT COUNT(Fax) and if I can then > >>>>>>> count the blanks then that might just give me the true extent of the wsheet. > >>>>>>> But I have my doubts because I think perhaps the 2 sums will still add up to > >>>>>>> the same figure as the much exagerated UsedRange. > >>>>>>> > >>>>>>> In my example I showed that 1 wbook I used had a UsedRange of AF50918 but > >>>>>>> the real last cell was only S98. So lets say the real records in Fax were > >>>>>>> 72. What I was hoping to do was count the blanks in Fax and get 25. i.e.
From: Geoff K on 30 Sep 2009 03:37 Hi Keiji I already have an algorthm which works very well on open wbooks. It is very quick. My post is about saving running time by NOT opening and closing wbooks. I will now experiment with the suggestion from michdenis. Thank you for your contribution. Geoff
From: Geoff K on 30 Sep 2009 03:55
Hi Thanks for the example. I have got it to work on a single field, the error was caused simply by reading a text field not a numeric. :) I now need to expand it to obtain the last row of the whole table. However this wbook UsedRange is so bloated, AF50918 compared to S98, and the loop used on duplicates is very slow even on a single field. I fear it will undo all the run time advantage of not opening and closing the wbook. But it is at least one way and worth further experimentation. Geoff "michdenis" wrote: > There is an exemple in this file : http://cjoint.com/?jDndv2hXXE |