I am thinking about to replace some VB-procedures that update reports created in Excel, VSFlexGrid, and Farpoint by procedures from FireFly. Data are mostly coming from Access databases. Before I do so I have created a little test. In an Excel sheet 10,000 rows should be updated by data from an Access table (25,000 rows). In the Excel sheets the keys correspoding with the data in the Access table are found in column 1 and 2.
When I run the test elapsed time:
VBA procedure (Office 2000) = 5 seconds
FireFly / PowerBasic 7 = 50 seconds.
About one year ago I tried to install SQL Tools, vers. 2 Pro. Here I couldn’t use the Seek command from ADO but I used the functionality available in SQL Tools. I went through a similar test. The difference was nearly the same that I had to multiply elapsed time from VBA by 10.
Could anybody give me an idea where I could speed-up the process that performance could be acceptable or do I need to accept that this is the way it is.
VBA (Office 2000)
Private ConnDB As New ADODB.Connection
Private AccountTab As New ADODB.Recordset
Private Const pass As String = “"
Private xlBook As Excel.Workbook
Private RowCounter As Integer
Private WorkDir As String
Sub OpenDB()
WorkDir = "c:\FireFly\Project1\"
ConStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & WorkDir & "TestDatabase.mdb;" & _
"User Id=admin;"
With ConnDB
.ConnectionString = ConStr
.ConnectionTimeout = 30
.Open
End With
AccountTab.Open "ACCOUNTS", ConnDB, adOpenStatic, adLockReadOnly, adCmdTableDirect
AccountTab.Index = "PrimaryKey"
Set xlBook = Workbooks.Open(WorkDir & "Test.xls")
For RowCounter = 2 To 10001
AccountTab.Seek Array(Sheets("Sheet1").Cells(RowCounter, 1).Value, _
Sheets("Sheet1").Cells(RowCounter, 2).Value), adSeekFirstEQ
If AccountTab.EOF = False Then
Sheets("Sheet1").Cells(RowCounter, 3).Value = AccountTab!Text
End If
Next
End Sub
FireFly / PowerBasic vers. 7
#Include "ExcelApp.inc"
Sub DBStart()
Dim ConnDB As Dword
Dim ConStr As String
Dim AccountTab As Dword
Dim vRes As Variant
Dim xlApp As ExcelApplication
Dim xlBook As ExcelWorkbook
Dim xlSheet As ExcelWorksheet
Dim vBool As Variant
Dim oVnt As Variant
Dim vInFile As Variant
Dim vSheet As Variant
Dim RowCounter As Integer
Dim vRow As Variant
Dim vCol As Variant
Dim xlCol As Variant
Dim vCrit(1) As Variant
ConnDB = FF_AdoCreateObject("ADODB.Connection")
ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurDir$ & _ "\TestDatabase.mdb;" & "user id=admin;"
FF_AdoConnection_Open ConnDB, ConStr
AccountTab = FF_AdoCreateObject("ADODB.Recordset")
FF_AdoRecordset_Open AccountTab, "ACCOUNTS", ConnDB, %adOpenStatic, _
%adLockReadOnly, %adCmdTableDirect
FF_AdoRecordset_SetIndex(AccountTab, "PrimaryKey")
Set xlApp = New ExcelApplication In $PROGID_ExcelApplication11
Let vInFile = CurDir$ & "\Test.xls"
Object Call xlApp.WorkBooks.Open(Filename = vInFile) To oVnt
Set xlBook = oVnt
Let vSheet = "Sheet1"
Object Get xlBook.WorkSheets(vSheet) To oVnt
Set xlSheet = oVnt
Object Call xlSheet.Activate
vCol = 3 'the column in Excel sheet that has to be updated
For RowCounter = 2 To 10001
vRow = RowCounter
'fetch the keys from Excel-sheet column 1 and 2
xlCol = 1
Object Get xlSheet.Cells.Item(vRow,xlCol) To vCrit(0)
xlCol = 2
Object Get xlSheet.Cells.Item(vRow,xlCol) To vCrit(1)
FF_AdoRecordset_Seek(AccountTab,vCrit(), 1)
‘update Excel-sheet column 3
If Not FF_Adorecordset_EOF(AccountTab) Then
FF_AdoRecordset_GetCollect(AccountTab, "Text", vRes)
Object Let xlSheet.Cells.Item(vRow,vCol) = vRes
End If
Next
Let vBool = 1
Object Let xlApp.Visible = vBool
End Sub
I suggest that you direct your query over to Jose Roca. He is the mastermind behind the ADO code found in FireFly. He would have better insight into the problem than I would. Jose's forum is located at: http://www.forum.it-berater.org
Sorry Henning, I wasn't aware of your post. For some reason, I wasn't being logged automatically when I clicked Firefly's link in my favorite's folder and, seeing not the light indicator of new posts, I thought that all Firefly users where on holidays in Spain :)
It doesn't look a Seek's problem, but the way you are using the calls to get the row in Excel:
Object Get xlSheet.Cells.Item(vRow,xlCol) To vCrit(0)
VBA should be optimized to know that only a call to the Item property should be performed. But this kind of syntax its a performance killer when using PB. I will explain why:
When using xlSheet.Cells.Item with PB, a call to xlSheet.Cells is performed, creating a collection of cells and storing the collection's reference in a temporary object variable. Then, a call to the Item method is performed to get the value and the temporary object variables and the collection are destroyed. So, at each iteration, a collection of cells is being created and destroyed.
To avoid it, get the reference to the cells collection outside the loop and perform only a call to the Item method.
Before the loop:
LOCAL vCells AS VARIANT
LOCAL oCells AS ExcelRange
OBJECT GET xlSheet.Cells TO vCells
SET oCells = vCells
Inside the loop:
Object Get oCells.Item(vRow,xlCol) To vCrit(0)
Hope this helps.
See? I told you Jose was The Man with the answer. :D
The Item property is also a big performance killer, and is being used two times to get the cell: first to get the value and later to set the value. For optimal performance, the loop should use an enumerator, but that requires low-level programming and the use of the IEnumVARIANT interface, and mixing Automation with low-level techniques isn't easy, much less with Office applications, developed with scripting languages in mind. Because of its characteristics, IMO PB should have chosen to natively support direct VTable calls instead of/or in addition to Automation, like C. In its attempt to implement COM support without the VB bloat, what we have got is an implementation that has neither the easiness of use of VB nor the power of low-level programming. Hope this will change.
Note: Instead of "VBA should be optimized to know that only a call to the Item property should be performed." I mean a call to the Cells property, that creates the collection.
Jose: Thank you very much for your help.
Best regards
Henning Thomsen