Help speed up this VB6 code

[donbolinger]

In conjunction with MAS 200 (Sage) and Access 97, we have a script that generates sales order numbers for a batch of orders that have been imported into the Access database. The code runs very slow and we are hoping to see if anything can be removed / changed to make it faster. Here is the code (followed by the Module named GetNextSONum):

Private Sub cmdGenerate_Click()
   Dim rst As DAO.Recordset, db As DAO.Database, rstSO As DAO.Recordset, rstCust As DAO.Recordset
   Dim Skipped As Boolean, SONum As String, CustNum As String, TooLong As Boolean
   Dim curOrderNum As String
    
   Skipped = False
   TooLong = False
    curOrderNum = vbNullString
    
    cmdCancel.SetFocus
    cmdGenerate.Enabled = False
    chkYahoo.Enabled = False
    chkShopAmex.Enabled = False
    chkComerxia.Enabled = False
    chkAmazon.Enabled = True
    
    Set db = CurrentDb
    Screen.MousePointer = 11
    
    If chkAmazon Then
       db.Execute "UPDATE [Orders-Amazon] SET [Orders-Amazon].[buyer-name] = xg_ReplaceAllWith([buyer-name],"""""""",""'"") WHERE ((([Orders-Amazon].[buyer-name]) Like ""*""""*""))"
       DoEvents
       Set rst = db.OpenRecordset("Orders-Amazon")
        
       If rst.RecordCount > 0 Then
           rst.MoveFirst
           Do
StartOfAmazonLoop:
                If curOrderNum = vbNullString Then
                    curOrderNum = rst![order-id]
                Else
                    If rst![order-id] = curOrderNum Then
                        rst.MoveNext
                        GoTo StartOfAmazonLoop
                    Else
                        curOrderNum = rst![order-id]
                    End If
                End If
                
                
                Set rstSO = db.OpenRecordset("SELECT * FROM [Order Links] WHERE [Order_num] = '" & rst![order-id] & "'")
                
                If rstSO.RecordCount <= 0 Then
                    SONum = GetNextSONum
                    'Set rstCust = db.OpenRecordset("SELECT MAS_Customers.CustomerNumber FROM MAS_Customers WHERE (((Ucase(MAS_Customers.CustomerName))=""" & UCase(rst![buyer-name]) & """) AND ((Ucase(MAS_Customers.AddressLine1))=""" & UCase(rst![ship-address-1]) & """) AND ((MAS_Customers.ZipCode)='" & rst![ship-postal-code] & "')" & IIf(IsNull(rst![ship-address-2]), vbNullString, " AND((ucase(MAS_Customers.AddressLine2))=""" & UCase(rst![ship-address-2]) & """)") & IIf(IsNull(rst![ship-address-3]), vbNullString, " AND ((Ucase(MAS_Customers.AddressLine3))=""" & UCase(rst![ship-address-3]) & """)") & ")")
                    
                    
                    'If Not rstCust.EOF Then
                        'CustNum = rstCust!Customernumber
                    'Else
                        'rstCust.Close
                        'Set rstCust = db.OpenRecordset("SELECT AR1_CustomerMaster.CustomerNumber FROM AR1_CustomerMaster WHERE (((Ucase(AR1_CustomerMaster.CustomerName))=""" & UCase(rst![buyer-name]) & """) AND ((Ucase(AR1_CustomerMaster.AddressLine1))=""" & UCase(rst![ship-address-1]) & """) AND ((AR1_CustomerMaster.ZipCode)='" & rst![ship-postal-code] & "')" & IIf(IsNull(rst![ship-address-2]), vbNullString, " AND((Ucase(AR1_CustomerMaster.AddressLine2))=""" & UCase(rst![ship-address-2]) & """)") & IIf(IsNull(rst![ship-address-3]), vbNullString, " AND ((Ucase(AR1_CustomerMaster.AddressLine3))=""" & UCase(rst![ship-address-3]) & """)") & ")")
                        
                        'If Not rstCust.EOF Then
                            'CustNum = rstCust!Customernumber
                        'Else
                            'CustNum = GetNextCustNum
                            'NewCustomer = True
                        'End If
                    'End If
                    'rstCust.Close
                    
                    db.Execute "INSERT INTO [Order Links] (MAS_num, Order_num) VALUES ('" & SONum & "','" & rst![order-id] & "')"
                    
                    'If NewCustomer Then
                    '    Set rstCust = db.OpenRecordset("MAS_Customers")
                    '    rstCust.AddNew
                    '    rstCust!Customernumber = CustNum
                    '    rstCust!customername = Left(rst![buyer-name], 30)
                    '    rstCust!addressline1 = Left(rst![ship-address-1], 30)
                    '    rstCust!addressline2 = Left(rst![ship-address-2], 30)
                    '    rstCust!addressline3 = Left(rst![ship-address-3], 30)
                    '    rstCust!Zipcode = rst![ship-postal-code]
                    '    rstCust.Update
                    '    rstCust.Close
                    '    DoEvents
                    '    NewCustomer = False
                    '    If TooLong = False Then
                    '        If Len(rst![buyer-name]) > 30 Or Len(rst![ship-address-1]) > 30 Or Len(rst![ship-address-2]) > 30 Or Len(rst![ship-address-3]) > 30 Then
                    '            TooLong = True
                    '        End If
                    '    End If
                    'End If
                    
                Else
                    Skipped = True
                End If
                
                rstSO.Close
                
                rst.MoveNext
            Loop While Not rst.EOF
        End If
        rst.Close
        curOrderNum = vbNullString
    End If
    
    cmdGenerate.Enabled = True
    chkYahoo.Enabled = False
    chkShopAmex.Enabled = False
    chkComerxia.Enabled = False
    chkAmazon.Enabled = True
    Screen.MousePointer = 0
    Dim FinishedMessage As String
    
    FinishedMessage = "Finished Generating Numbers."
    If Skipped Then
        FinishedMessage = FinishedMessage & "  Some Orders appeared to have already had Numbers Generated for them and were skipped."
    End If
    If TooLong Then
        FinishedMessage = FinishedMessage & "  One or more orders had fields that were too long for MAS, please run the Address Manipulation Form to truncate these fields."
    End If
    
    If TooLong Or Skipped Then
        MsgBox FinishedMessage, vbExclamation, "Generating Complete"
    Else
        MsgBox FinishedMessage, vbOKOnly, "Generating Complete"
    End If
    
    DoCmd.Close acForm, Me.Name, acSaveNo
    
    
End Sub

=====================================================
From Access Module1:

Public Function GetNextSONum() As String
    Dim db As DAO.Database, rst1 As DAO.Recordset
    Dim strNum As String
    
    GetNextSONum = "*ERROR*"
    
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("SELECT MAX([MAS_Num]) FROM [Order Links]")
    
    strNum = rst1.Fields(0).Value
    strNum = CStr(Hex(CLng("&H" & strNum) + 1))

    rst1.Close
    Set rst1 = db.OpenRecordset("SELECT * FROM [Order Links] WHERE [MAS_Num] LIKE '*" & strNum & "'")
    
    If rst1.RecordCount > 0 Then
        Do
            strNum = CStr(Hex(CLng("&H" & strNum) + 1))
            rst1.Close
            Set rst1 = db.OpenRecordset("SELECT * FROM [Order Links] WHERE [MAS_Num] LIKE '*" & strNum & "'")
        Loop While rst1.RecordCount > 0
    End If
    
    rst1.Close
    Set rst1 = db.OpenRecordset("SELECT * FROM [SO_03SOHistoryHeader] WHERE [SalesOrderNumber] LIKE '*" & strNum & "'")
    
    If rst1.RecordCount > 0 Then
        Do
            strNum = CStr(Hex(CLng("&H" & strNum) + 1))
            rst1.Close
            Set rst1 = db.OpenRecordset("SELECT * FROM [SO_03SOHistoryHeader] WHERE [SalesOrderNumber] LIKE '*" & strNum & "'")
        Loop While rst1.RecordCount > 0
    End If
    
    rst1.Close
    
    If Len(strNum) < 7 Then
        strNum = String(7 - Len(strNum), "0") & strNum
    End If
    
    GetNextSONum = strNum
End Function

 

[Techtnologies]

I would start by removing the SELECT * statements. This is just bad practice in general.

What DB platform is MAS200 running on? If SQL Server you may have better luck with processing on the server and exporting using DTS.

Regards,



Chad
Techtnologies LLC

http://www.techtnologies.com

 

[jadams0173]

Maybe switching to ADODB instead of DAO. Do some searches on this fora and you should be able to find some posts that talk about the difference in speed in the two.

 

[LazyMe]

I doubt that ADO will be faster agains an Access database then DAO. I would even state that DAO will be faster in this case......

Greetings,
Rick

 

[Ed2020]

I'd second Rick's statement about DAO being faster on Access/Jet tables. All the tests I have performed confirm this.

Ed Metcalfe.

Please do not feed the trolls.....

 

[strongm]

And Microsoft agree. DAO is faster against Jet than ADO

 

[Golom]

I may be way off-base with this but I infer that you are storing the [MAS_Num] field as a HEX value padded to seven digits (e.g. 000A3B5) and you save it as a text field. The loading on your system is probably coming from all those text-based searches. Perhaps you could try something where the conversion to numeric is performed in SQL rather than your code.

Public Function GetNextSONum() As String
    Dim db                          As DAO.Database
    Dim rst1                        As DAO.Recordset
    Dim S1                          As Long
    Dim S2                          As Long

    GetNextSONum = "*ERROR*"

    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("SELECT MAX(cLng('&H' & [MAS_Num])) " & _
                                "FROM [Order Links]")
    S1 = IIf(IsNull(rst1.Fields(0).Value), 1, rst1.Fields(0).Value + 1)
    rst1.Close

    Set rst1 = db.OpenRecordset("SELECT MAX(cLng('&H' & [MAS_Num])) " & _
                                "FROM [SO_03SOHistoryHeader] ")
    S2 = IIf(IsNull(rst1.Fields(0).Value), 1, rst1.Fields(0).Value + 1)
    rst1.Close

    GetNextSONum = Right("0000000" & Hex(IIf(S1 >= S2, S1, S2)), 7)

End Function

 

[Golom]

Even better

Public Function GetNextSONum() As String
    Dim rst1                        As DAO.Recordset
    Dim S1                          As Long
    Dim S2                          As Long
    Dim SQL                         As String

    SQL = "SELECT MAX([MAS_Num]) As X FROM [Order Links]"
    Set rst1 = CurrentDb.OpenRecordset(SQL)
    S1 = CLng("&H" & IIf(IsNull(rst1![X]), 0, rst1![X])) + 1
    
    SQL = Replace(SQL, "Order Links", "SO_03SOHistoryHeader")
    Set rst1 = CurrentDb.OpenRecordset(SQL)
    S2 = CLng("&H" & IIf(IsNull(rst1![X]), 0, rst1![X])) + 1

    Set rst1 = Nothing
    
    GetNextSONum = Right("0000000" & Hex(IIf(S1 >= S2, S1, S2)), 7)

End Function

and make sure that [MAS_Num] is indexed in both tables.

 

[jadams0173]

I stand corrected on the ado/dao topic! Sorry...

 

[BobRodes]

If you're using ADO, you can get much faster (several times as fast, typically) throughput by indexing a recordset:

myRs.fields(myFieldNumber).Properties("Optimize") = true

I believe there's also a way to do this with DAO, but I'm not sure how.

HTH

Bob

 

[Golom]

With either ADO or DAO you can

xx.Execute "CREATE INDEX IndexName ON myTable (myField) WITH IGNORE NULL"

Where "xx" would be a connection object in ADO or a Database object in DAO.

 

[BobRodes]

Golom, if you're iterating through a recordset, can it use an index in the underlying database? I mean, the Optimize property is an index on the recordset itself. Is this the same?

 

[Golom]

BobRodes
Generally no. A recordset may be a subset of the data in the table (or in several tables) and the table index is a index on all the data in the table. What indexing the table (rather than the recordset) can do for you is make the SELECT to build the recordset much quicker.

Without a table index, SQL is forced to do a full table scan to retrieve records and, in large tables, that can be pretty labor[sup]1[/sup]-intensive.

In the code I was building for the OP, I was concerned with optimizing the retrieval of data into the recordset rather than optimizing the recordset after it was retrieved ... hence tha table index rather than building temporary indexes for the recordset.


[sup]1[/sup] - or "labour" for those across the pond.

 

[BobRodes]

Golom--Ok, that's the way I see it too. I noticed that the OP was iterating through recordsets, and I've found that that runs a lot faster when the recordset itself is indexed using the optimize property. So maybe both indexes will help.

Bob

 

[Golom]

BobRodes
Actually what was costing the time for the OP (who now seems to have disappeared from this thread) was the fact that he was retrieving numerous recordsets from the database using constructs like

Do
   strNum = CStr(Hex(CLng("&H" & strNum) + 1))
   rst1.Close
   Set rst1 = db.OpenRecordset( _
              "SELECT * FROM [Order Links] " & _
              "WHERE [MAS_Num] LIKE '*" & strNum & "'")
Loop While rst1.RecordCount > 0

In short, he wasn't searching through the recordset after it was retrieved ... he was searching the database repeatedly for different recordsets.

As it turned out, HEX values stored as zero-padded text strings do sort correctly in the sense that the MAX(TextString) is also the MAX("&H" & TextString). You can use the MAX operator on an indexed text field and do one retrieval rather than dozens (hundreds?, thousands?) of them to get the same result.

 

[donbolinger]

Sorry for my absence. Actually, after rebooting the server this code has been running quite fast for us since my last post. Since I don't have enough knowlege of visual basic, I am hesitant to mess with it (now that it's working). However, I know it is going to slow down over time once the underlying tables increase in size.

Thank you for all your input!