Sage Accpac 500 ERP (Version 5.5A)
SQL Server 2005
I created a macro that is supposed to cancel any back orders. The client tells me it takes 35 minutes for the macro to run through one day's worth of back orders (manually it takes them 2.5 hours).
If I test with only 5 back orders, they get processed in one second flat. I've asked for their log files (that my macro creates) to get an idea how big their dataset is, but it must be much larger considering how long it takes them to do the updates manually.
Anyways, can you take a look and see anything that looks inefficient, or recommend a better way of doing this:
SQL Server 2005
I created a macro that is supposed to cancel any back orders. The client tells me it takes 35 minutes for the macro to run through one day's worth of back orders (manually it takes them 2.5 hours).
If I test with only 5 back orders, they get processed in one second flat. I've asked for their log files (that my macro creates) to get an idea how big their dataset is, but it must be much larger considering how long it takes them to do the updates manually.
Anyways, can you take a look and see anything that looks inefficient, or recommend a better way of doing this:
Code:
Private Function APResetBackorders(StartDate As Date, EndDate As Date) As Boolean
On Error GoTo ErrHandler
Dim FUNCTION_NAME As String
FUNCTION_NAME = "APResetBackorders"
Dim mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)
Dim strFilter As String
Dim strOrdNumber As String
Dim strOrdUniq As String
Dim strItemID As String
Dim strLineNum As String
Dim dblQty As Double
Dim bolErrors As Boolean
Dim temp As Boolean
Dim bolDetailsUpdated As Boolean
Dim vwHeader As AccpacCOMAPI.AccpacView
Dim vwHeaderFields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0520", vwHeader
Set vwHeaderFields = vwHeader.Fields
Dim vwDetail As AccpacCOMAPI.AccpacView
Dim vwDetailFields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0500", vwDetail
Set vwDetailFields = vwDetail.Fields
Dim OEORD1detail2 As AccpacCOMAPI.AccpacView
Dim OEORD1detail2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0740", OEORD1detail2
Set OEORD1detail2Fields = OEORD1detail2.Fields
Dim OEORD1detail3 As AccpacCOMAPI.AccpacView
Dim OEORD1detail3Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0180", OEORD1detail3
Set OEORD1detail3Fields = OEORD1detail3.Fields
Dim OEORD1detail4 As AccpacCOMAPI.AccpacView
Dim OEORD1detail4Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0680", OEORD1detail4
Set OEORD1detail4Fields = OEORD1detail4.Fields
Dim OEORD1detail5 As AccpacCOMAPI.AccpacView
Dim OEORD1detail5Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0526", OEORD1detail5
Set OEORD1detail5Fields = OEORD1detail5.Fields
Dim OEORD1detail6 As AccpacCOMAPI.AccpacView
Dim OEORD1detail6Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0522", OEORD1detail6
Set OEORD1detail6Fields = OEORD1detail6.Fields
Dim OEORD1detail7 As AccpacCOMAPI.AccpacView
Dim OEORD1detail7Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0501", OEORD1detail7
Set OEORD1detail7Fields = OEORD1detail7.Fields
Dim OEORD1detail8 As AccpacCOMAPI.AccpacView
Dim OEORD1detail8Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0502", OEORD1detail8
Set OEORD1detail8Fields = OEORD1detail8.Fields
Dim OEORD1detail9 As AccpacCOMAPI.AccpacView
Dim OEORD1detail9Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0504", OEORD1detail9
Set OEORD1detail9Fields = OEORD1detail9.Fields
Dim OEORD1detail10 As AccpacCOMAPI.AccpacView
Dim OEORD1detail10Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "OE0503", OEORD1detail10
Set OEORD1detail10Fields = OEORD1detail10.Fields
vwHeader.Compose Array(vwDetail, OEORD1detail4, OEORD1detail3, OEORD1detail2, OEORD1detail5, OEORD1detail6)
vwDetail.Compose Array(vwHeader, OEORD1detail7, OEORD1detail10, OEORD1detail8)
OEORD1detail2.Compose Array(vwHeader)
OEORD1detail3.Compose Array(vwHeader, vwDetail)
OEORD1detail4.Compose Array(vwHeader, vwDetail)
OEORD1detail5.Compose Array(vwHeader)
OEORD1detail6.Compose Array(vwHeader)
OEORD1detail7.Compose Array(vwDetail)
OEORD1detail8.Compose Array(vwDetail, OEORD1detail9)
OEORD1detail9.Compose Array(OEORD1detail8)
OEORD1detail10.Compose Array(vwDetail)
'Filter for orders within the date range and have shipments
strFilter = "OrdDate >= " & Format(StartDate, "YYYYMMDD") & " AND OrdDate <= " & Format(EndDate, "YYYYMMDD") & _
" AND NumShpMent > 0"
'**Debug test
'strFilter = "NumShpMent > 0"
vwHeader.Browse strFilter, True
Do While vwHeader.Fetch
strOrdNumber = vwHeader.Fields("OrdNumber").Value
strOrdUniq = vwHeader.Fields("OrdUniq").Value
bolDetailsUpdated = False
'Filter for details that have back orders and are LineType "Item"
strFilter = "QtyBackOrd > 0 AND LineType = 1"
vwDetail.Browse strFilter, 1
Do While vwDetail.Fetch
'Double-check that this is within the Order of the outer loop
If vwDetail.Fields("OrdUniq").Value = strOrdUniq Then
strLineNum = vwDetail.Fields("LineNum").Value
strItemID = vwDetail.Fields("Item").Value
dblQty = vwDetail.Fields("QtyBackOrd").Value
vwDetail.Fields("QTYORDERED").Value = "0.0000"
vwDetail.Fields("COMPLETE").Value = "1"
vwDetail.Update
'Write to log
WriteToBackLog strOrdNumber, strLineNum, strItemID, CStr(dblQty)
bolDetailsUpdated = True
End If
Loop
'** Possibly may need following two lines of code
' vwHeaderFields("OECOMMAND").Value = "4" ' Process O/E Command
' vwHeader.Process
If bolDetailsUpdated Then
vwHeader.Update
End If
Loop
End_Function:
APResetBackorders = Not bolErrors
Exit Function
ErrHandler:
Dim strError As String
Dim lCount As Long
Dim lIndex As Long
Dim lErrNo As Long
If Errors Is Nothing Then
strError = Err.Description
If Erl <> 0 Then
strError = strError & " LINE " & Erl
End If
WriteToErrorLog FUNCTION_NAME, Err.Number, strError
Else
lCount = Errors.Count
If lCount = 0 Then
strError = Err.Description
If Erl <> 0 Then
strError = strError & " LINE " & Erl
End If
WriteToErrorLog FUNCTION_NAME, Err.Number, strError
Else
strError = "AccPac errors:"
lErrNo = 0
For lIndex = 0 To lCount - 1
lErrNo = lErrNo + 1
strError = strError & " " & lErrNo & ". " & Errors.Item(lIndex) & ";"
Next
If Erl <> 0 Then
strError = strError & " LINE " & Erl
End If
WriteToErrorLog FUNCTION_NAME, 0, strError
Errors.Clear
End If
End If
bolErrors = True
Resume End_Function
End Function