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 2 Oct 2009 16:42 Try this code: Sub test() MsgBox GetXLRows("C:\ExcelFiles\", "Test.xls", "Sheet1") End Sub Function GetXLRows(strPath As String, _ strFile As String, _ strSheet As String, _ Optional lMinColumn As Long = 1, _ Optional lMaxColumn As Long = 256, _ Optional lMinRow As Long = 1, _ Optional lMaxRow As Long = 65536) As Long Dim i As Long Dim lOldMinRow As Long Dim lOldMaxRow As Long Dim strArg As String On Error GoTo ERROROUT If Right$(strPath, 1) <> "\" Then strPath = strPath & "\" End If If bFileExists(strPath & strFile) = False Then GetXLRows = -1 Exit Function End If strArg = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" & _ "R" & lMaxRow & "C" & lMinColumn & _ ":R" & lMaxRow & "C" & lMaxColumn & ")" If ExecuteExcel4Macro(strArg) > 0 Then GetXLRows = lMaxRow Exit Function End If Do While lMaxRow > lMinRow strArg = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" & _ "R" & lMinRow & "C" & lMinColumn & _ ":R" & lMaxRow & "C" & lMaxColumn & ")" If ExecuteExcel4Macro(strArg) > 0 Then If i Mod 2 = 0 Then lOldMinRow = lMinRow lMinRow = (lMaxRow + lMinRow) \ 2 If lMinRow = lOldMinRow Then GetXLRows = lMinRow Exit Function End If End If Else If i = 0 Then 'nil found in whole range, so return zero '---------------------------------------- Exit Function Else If i Mod 2 = 0 Then lMinRow = lMaxRow lMaxRow = lOldMaxRow Else lMaxRow = lMinRow lMinRow = lOldMinRow End If End If End If i = i + 1 Loop GetXLRows = lMinRow Exit Function ERROROUT: GetXLRows = -2 End Function Function bFileExists(ByVal sFile As String) As Boolean Dim lAttr As Long On Error Resume Next lAttr = GetAttr(sFile) bFileExists = (Err.Number = 0) And ((lAttr And vbDirectory) = 0) On Error GoTo 0 End Function RBS "Geoff K" <GeoffK(a)discussions.microsoft.com> wrote in message news:E7642731-38C0-43BE-A67A-5611162F2983(a)microsoft.com... > Hi John > I do not want to ever open source wbooks if I can possibly avoid it. > > They are used once only to extract data and are not used again unless > there > are anomalies in the final analysis. Opening and closing wbooks wastes > time > if you only need their data and there are so many of them. > > Somehow I have to get the real last row BEFORE I begin to extract data > because I need to establish the original record count. > > I use ADO for extraction and it works fine. But when I use a SELECT COUNT > (*) to get a record count it gets messed up sometimes because a wbook may > have been saved with an out of line UsedRange. > > One wbook I came across showed the last UsedRange call as AF50918 instead > of > S98. That produced an original record count of 50917 instead of 97. > > I've been through a number of alternatives then came across the method > which > I posted. But it doesn't work consistently. It seems ok if the first > field > in a closed wbook is numeric - and it reurns N/A if it encounters a text > field - but if the first field is a text field then it throws a wobbler. > > If I can get the thing to work correctly I can install formulae on the > hidden wsheet of my Add-in and loop through all the wbooks in the folder > and > calculate the number of original records in each. > > Geoff > > "john" wrote: > >> Geoff, >> >> Use a helper cell in the closed workbook and add formula like this: >> >> =COUNTA(A:A) >> >
From: Geoff K on 2 Oct 2009 18:30 Hi John That was interesting but still not there. Yes it overcomes the data type issue but does not count the nulls and I do need the last used row which includes nulls rather than a count. It was also interesting because I continued testing MATCH to see how data type affected results in a number of other wbooks. I found that using MATCH (99^99 etc worked correctly on numeric fields and returned N/A on text and vice versa when using MATCH("ZZZ" etc. - not unexpectedly I might add now. In the case where a number (not N/A) was returned it proved to be the last used row in that column which is what I'm after. If I can get MATCH to read both types all I have to do is loop through all fields of the wbook to get the maximun row number. What is confusing the whole investigation is the wbook with the huge bloated UsedRange coincidently has a text first field. I thought it was the misuse of the data to MATCH, 99^99 or "ZZZ", that was creating the infinite loop. However COUNTA also causes the same problem in this same wbook. Thinking it might be the UsedRange I then tried MATCh on another misaligned UsedRange which also had a first field as text. It worked correctly on that. COUNTA didn't bother it either. The puzzle therefore is why does this one wbook (up to now) have this affect. If I do open it, it processes normally. I must resolve this. And my original question still stands also - how can I create a MATCH function which reads both text and numeric fields. Geoff john wrote: > sorry if first suggestion along wrong lines. > > not tested but does doing this solve text / numeric problem? > > =COUNTA('C:\Path\[File.xls]Sheet1'!A:A) > -- > jb
From: RB Smissaert on 2 Oct 2009 19:41 This will cut some cycles out, but not fully tested. This is probably done neatest with a recursive procedure, but I think this will do. Note that lCycles will tell you the efficiency of the code. Function GetXLRows(strPath As String, _ strFile As String, _ strSheet As String, _ Optional lMinColumn As Long = 1, _ Optional lMaxColumn As Long = 256, _ Optional lMinRow As Long = 1, _ Optional lMaxRow As Long = 65536, _ Optional lCycles As Long) As Long Dim lOldMinRow As Long Dim lOldMaxRow As Long Dim strArg As String Dim bPreviousFound As Boolean On Error GoTo ERROROUT If Right$(strPath, 1) <> "\" Then strPath = strPath & "\" End If If bFileExists(strPath & strFile) = False Then GetXLRows = -1 Exit Function End If strArg = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" & _ "R" & lMaxRow & "C" & lMinColumn & _ ":R" & lMaxRow & "C" & lMaxColumn & ")" If ExecuteExcel4Macro(strArg) > 0 Then GetXLRows = lMaxRow Exit Function End If Do While lMaxRow > lMinRow strArg = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" & _ "R" & lMinRow & "C" & lMinColumn & _ ":R" & lMaxRow & "C" & lMaxColumn & ")" 'for testing '----------- 'Cells(lCycles + 1, 1) = lMinRow 'Cells(lCycles + 1, 2) = lMaxRow 'Cells(lCycles + 1, 3) = lOldMinRow 'Cells(lCycles + 1, 4) = lOldMaxRow 'Cells(lCycles + 1, 6) = lCycles If ExecuteExcel4Macro(strArg) > 0 Then 'Cells(lCycles + 1, 5) = "found" 'for testing If bPreviousFound Or lCycles Mod 2 = 0 Then lOldMinRow = lMinRow lMinRow = (lMaxRow + lMinRow) \ 2 If lMinRow = lOldMinRow Then GetXLRows = lMinRow Exit Function End If End If bPreviousFound = True Else 'If ExecuteExcel4Macro(strArg) > 0 'Cells(lCycles + 1, 5) = "nil found" 'for testing If lCycles = 0 Then 'nil found in whole range, so return zero '---------------------------------------- Exit Function Else If bPreviousFound = False Then lOldMinRow = lMinRow lMinRow = lMaxRow lMaxRow = lOldMaxRow Else lOldMaxRow = lMaxRow lMaxRow = lMinRow lMinRow = lOldMinRow End If End If bPreviousFound = False End If 'If ExecuteExcel4Macro(strArg) > 0 lCycles = lCycles + 1 Loop GetXLRows = lMinRow Exit Function ERROROUT: GetXLRows = -2 End Function RBS "RB Smissaert" <bartsmissaert(a)blueyonder.co.uk> wrote in message news:%23sitUD6QKHA.764(a)TK2MSFTNGP02.phx.gbl... > Try this code: > > > Sub test() > > MsgBox GetXLRows("C:\ExcelFiles\", "Test.xls", "Sheet1") > > End Sub > > Function GetXLRows(strPath As String, _ > strFile As String, _ > strSheet As String, _ > Optional lMinColumn As Long = 1, _ > Optional lMaxColumn As Long = 256, _ > Optional lMinRow As Long = 1, _ > Optional lMaxRow As Long = 65536) As Long > > Dim i As Long > Dim lOldMinRow As Long > Dim lOldMaxRow As Long > Dim strArg As String > > On Error GoTo ERROROUT > > If Right$(strPath, 1) <> "\" Then > strPath = strPath & "\" > End If > > If bFileExists(strPath & strFile) = False Then > GetXLRows = -1 > Exit Function > End If > > strArg = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" & _ > "R" & lMaxRow & "C" & lMinColumn & _ > ":R" & lMaxRow & "C" & lMaxColumn & ")" > > If ExecuteExcel4Macro(strArg) > 0 Then > GetXLRows = lMaxRow > Exit Function > End If > > Do While lMaxRow > lMinRow > strArg = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" & > _ > "R" & lMinRow & "C" & lMinColumn & _ > ":R" & lMaxRow & "C" & lMaxColumn & ")" > > If ExecuteExcel4Macro(strArg) > 0 Then > If i Mod 2 = 0 Then > lOldMinRow = lMinRow > lMinRow = (lMaxRow + lMinRow) \ 2 > If lMinRow = lOldMinRow Then > GetXLRows = lMinRow > Exit Function > End If > End If > Else > If i = 0 Then > 'nil found in whole range, so return zero > '---------------------------------------- > Exit Function > Else > If i Mod 2 = 0 Then > lMinRow = lMaxRow > lMaxRow = lOldMaxRow > Else > lMaxRow = lMinRow > lMinRow = lOldMinRow > End If > End If > End If > i = i + 1 > Loop > > GetXLRows = lMinRow > > Exit Function > ERROROUT: > > GetXLRows = -2 > > End Function > > Function bFileExists(ByVal sFile As String) As Boolean > > Dim lAttr As Long > > On Error Resume Next > lAttr = GetAttr(sFile) > bFileExists = (Err.Number = 0) And ((lAttr And vbDirectory) = 0) > On Error GoTo 0 > > End Function > > > RBS > > > "Geoff K" <GeoffK(a)discussions.microsoft.com> wrote in message > news:E7642731-38C0-43BE-A67A-5611162F2983(a)microsoft.com... >> Hi John >> I do not want to ever open source wbooks if I can possibly avoid it. >> >> They are used once only to extract data and are not used again unless >> there >> are anomalies in the final analysis. Opening and closing wbooks wastes >> time >> if you only need their data and there are so many of them. >> >> Somehow I have to get the real last row BEFORE I begin to extract data >> because I need to establish the original record count. >> >> I use ADO for extraction and it works fine. But when I use a SELECT >> COUNT >> (*) to get a record count it gets messed up sometimes because a wbook may >> have been saved with an out of line UsedRange. >> >> One wbook I came across showed the last UsedRange call as AF50918 instead >> of >> S98. That produced an original record count of 50917 instead of 97. >> >> I've been through a number of alternatives then came across the method >> which >> I posted. But it doesn't work consistently. It seems ok if the first >> field >> in a closed wbook is numeric - and it reurns N/A if it encounters a text >> field - but if the first field is a text field then it throws a wobbler. >> >> If I can get the thing to work correctly I can install formulae on the >> hidden wsheet of my Add-in and loop through all the wbooks in the folder >> and >> calculate the number of original records in each. >> >> Geoff >> >> "john" wrote: >> >>> Geoff, >>> >>> Use a helper cell in the closed workbook and add formula like this: >>> >>> =COUNTA(A:A) >>> >> >
From: Geoff K on 2 Oct 2009 21:03 Hi Thank you. The method is interesting but very slow when operating on closed wbooks. First I tested it on the bloated UsedRange wbook (AF50918 v S98) - closed. Out of curiosity I waited more than 10 minutes and gave up. I then ran it with the wbook open - it took 0.04 seconds to return the correct last row of 98. Next, I ran it on another misaligned UsedRange wbook, Q1532 against real last cell of P153. Closed, this took 86 seconds. Opened, it took 0.01 seconds In execution the longest step was in the line If ExecuteExcel4Macro(strArg) > 0 Then within the Do While Loop. Stepping through with the bloated wbook closed, the code never moved past the line. So the original question remains, how can I get MATCH to return a row number from both numeric and text fields? And now this supplementary one - why does MATCH, COUNTA and this method fail on the bloated wbook but then processes correctly if I open it. Ah, I see you have sent another post. Many thanks but it is 02:01 here and I will test in the morning. Geoff "RB Smissaert" wrote: > Try this code: > > > Sub test() > > MsgBox GetXLRows("C:\ExcelFiles\", "Test.xls", "Sheet1") > > End Sub
From: RB Smissaert on 3 Oct 2009 02:46
This is some further optimized code plus added a timer and logging for testing. It works quite fast with me, but this is Excel 2003 and you might be on 2007. Also bear in mind that you can make it a lot faster if you limit the last column and you may know that or you may find that with a procedure with the same principle or you could even combine a search for the last row with a search for the last column. A really fast way to do this possibly is to work directly on the BIFF Excel file data and another option is to capture all the data with ADO into an array and then do a binary search (similar as in my code) on that array. Option Explicit Private lStartTime As Long Private Declare Function timeGetTime Lib "winmm.dll" () As Long Sub test() Dim LR As Long Dim lCycles As Long Dim bLog As Boolean 'bLog = True If bLog Then Cells.Clear End If StartSW LR = GetLastDataRow("C:\ExcelFiles\", "Lottery.xls", "Sheet1", _ , 23, , , lCycles, bLog) StopSW , "last data row: " & LR & ", " & "found with " & lCycles & " cycles" End Sub Function GetLastDataRow(strPath As String, _ strFile As String, _ strSheet As String, _ Optional lMinColumn As Long = 1, _ Optional lMaxColumn As Long = 256, _ Optional lMinRow As Long = 1, _ Optional lMaxRow As Long = 65536, _ Optional lCycles As Long, _ Optional bLogToSheet As Boolean) As Long Dim lOldMinRow As Long Dim lOldMaxRow As Long Dim strArgStart As String Dim strArg As String Dim bPreviousFound As Boolean On Error GoTo ERROROUT If Right$(strPath, 1) <> "\" Then strPath = strPath & "\" End If If bFileExists(strPath & strFile) = False Then GetLastDataRow = -1 Exit Function End If 'first check if very last row has data to do an early exit '--------------------------------------------------------- strArgStart = "COUNTA('" & strPath & "[" & strFile & "]" & strSheet & "'!" strArg = strArgStart & _ "R" & lMaxRow & "C" & lMinColumn & _ ":R" & lMaxRow & "C" & lMaxColumn & ")" If ExecuteExcel4Macro(strArg) > 0 Then GetLastDataRow = lMaxRow Exit Function End If lMaxRow = lMaxRow - 1 'as this was checked above lOldMinRow = lMinRow lOldMaxRow = lMaxRow Do While lMaxRow > lMinRow strArg = strArgStart & _ "R" & lMinRow & "C" & lMinColumn & _ ":R" & lMaxRow & "C" & lMaxColumn & ")" If bLogToSheet Then 'for testing '----------- Cells(lCycles + 1, 1) = lMinRow Cells(lCycles + 1, 2) = lMaxRow Cells(lCycles + 1, 3) = lOldMinRow Cells(lCycles + 1, 4) = lOldMaxRow Cells(lCycles + 1, 6) = lCycles End If If ExecuteExcel4Macro(strArg) > 0 Then If bLogToSheet Then Cells(lCycles + 1, 5) = "found" 'for testing End If lOldMinRow = lMinRow lMinRow = (lMaxRow + lMinRow) \ 2 If lMinRow = lOldMinRow Then GetLastDataRow = lMinRow Exit Function End If bPreviousFound = True Else 'If ExecuteExcel4Macro(strArg) > 0 If bLogToSheet Then Cells(lCycles + 1, 5) = "nil found" 'for testing End If If lCycles = 0 Then 'nil found in whole range, so return zero '---------------------------------------- Exit Function Else If bPreviousFound = False Then lOldMinRow = lMinRow lMinRow = lMaxRow lMaxRow = lOldMaxRow Else lOldMaxRow = lMaxRow lMaxRow = lMinRow lMinRow = lOldMinRow End If End If bPreviousFound = False End If 'If ExecuteExcel4Macro(strArg) > 0 lCycles = lCycles + 1 Loop GetLastDataRow = lMinRow Exit Function ERROROUT: GetLastDataRow = -2 End Function Function bFileExists(ByVal sFile As String) As Boolean Dim lAttr As Long On Error Resume Next lAttr = GetAttr(sFile) bFileExists = (Err.Number = 0) And ((lAttr And vbDirectory) = 0) On Error GoTo 0 End Function Sub StartSW() lStartTime = timeGetTime() End Sub Function StopSW(Optional bMsgBox As Boolean = True, _ Optional vMessage As Variant, _ Optional lMinimumTimeToShow As Long = -1) As Variant Dim lTime As Long lTime = timeGetTime() - lStartTime If lTime > lMinimumTimeToShow Then If IsMissing(vMessage) Then StopSW = lTime Else StopSW = lTime & " - " & vMessage End If End If If bMsgBox Then If lTime > lMinimumTimeToShow Then MsgBox "Done in " & lTime & " msecs", , vMessage End If End If End Function RBS "Geoff K" <GeoffK(a)discussions.microsoft.com> wrote in message news:04209BE7-291C-4BB6-8928-113CE2A824F2(a)microsoft.com... > Hi > > Thank you. The method is interesting but very slow when operating on > closed > wbooks. > > First I tested it on the bloated UsedRange wbook (AF50918 v S98) - closed. > Out of curiosity I waited more than 10 minutes and gave up. > I then ran it with the wbook open - it took 0.04 seconds to return the > correct last row of 98. > > Next, I ran it on another misaligned UsedRange wbook, Q1532 against real > last cell of P153. > Closed, this took 86 seconds. Opened, it took 0.01 seconds > > In execution the longest step was in the line If > ExecuteExcel4Macro(strArg) >> 0 Then within the Do While Loop. > Stepping through with the bloated wbook closed, the code never moved past > the line. > > So the original question remains, how can I get MATCH to return a row > number > from both numeric and text fields? > And now this supplementary one - why does MATCH, COUNTA and this method > fail > on the bloated wbook but then processes correctly if I open it. > > Ah, I see you have sent another post. Many thanks but it is 02:01 here > and > I will test in the morning. > > Geoff > > "RB Smissaert" wrote: > >> Try this code: >> >> >> Sub test() >> >> MsgBox GetXLRows("C:\ExcelFiles\", "Test.xls", "Sheet1") >> >> End Sub > |