Scheduled Script to process sales orders
Posted: Mon Apr 28, 2008 1:12 pm
Just thought I'd share a scheduled script I wrote recently, which I thought some of you may find useful... it processes all sales orders.
Enjoy!
Enjoy!
- Code: Select all
Dim SystemProfileObject
Dim ProcessBatchObject
Dim PrintingOptions
Dim lFromInvoiceNo
Dim lToInvoiceNo
Dim lFromDebtor
Dim lToDebtor
Dim lFromDate
Dim lToDate
Dim lFromStaff
Dim lToStaff
Dim lFromBranch
Dim lToBranch
If rtnErrorString = "" Then
Set SystemProfileObject = CreateObject("JiwaSysProfile.clsSysProfile")
Set myFSO = CreateObject("Scripting.FileSystemObject")
End If
If rtnErrorString = "" Then
If myFSO.FileExists(JiwaDatabaseObject.IniFile) = True Then
If SystemProfileObject.Load(JiwaDatabaseObject.IniFile) = False Then
rtnErrorModule = SystemProfileObject.ErrorModule
rtnErrorString = "Error loading system profile file (XML) : " & SystemProfileObject.ErrorMessage
Exit Sub
End If
End If
End If
If rtnErrorString = "" Then
Set ProcessBatchObject = CreateObject("JiwaProcessSOBatch.clsBatch")
Set ProcessBatchObject.Database = JiwaDatabaseObject
Set ProcessBatchObject.CommonLib = JiwaCommonLibObject
Set ProcessBatchObject.JLib = JiwaLibObject
Set ProcessBatchObject.SystemProfile = SystemProfileObject
End If
If rtnErrorString = "" Then
If ProcessBatchObject.Setup = 0 Then
rtnErrorString = "Error setting up JiwaProcessSOBatch Object : " & ProcessBatchObject.ErrorString
rtnErrorModule = ProcessBatchObject.ErrorModule
End If
End If
If rtnErrorString = "" Then
If ProcessBatchObject.PrepareNewRecord = 0 Then
rtnErrorString = "Error preparing new JiwaProcessSOBatch record : " & ProcessBatchObject.ErrorString
rtnErrorModule = ProcessBatchObject.ErrorModule
End If
End If
' Uncomment the following code if you just want to process a single, particular invoice - you can use
' AddInvoice to add as many invoices you want to the queue.
'If rtnErrorString = "" Then
' If ProcessBatchObject.AddInvoice(SingleInvoiceID) = 0 Then
' rtnErrorString = "Error adding invoice to process queue : " & ProcessBatchObject.ErrorString
' rtnErrorModule = ProcessBatchObject.ErrorModule
' End If
'End If
If rtnErrorString = "" Then
lFromInvoiceNo = ""
lToInvoiceNo = ""
lFromDebtor = ""
lToDebtor = ""
lFromDate = ""
lToDate = ""
lFromStaff = ""
lToStaff = ""
lFromBranch = ""
lToBranch = ""
lErrorString = ""
lErrorModule = ""
If SetDefaultRanges(JiwaDatabaseObject, lFromInvoiceNo, lToInvoiceNo, lFromDebtor, lToDebtor, lFromDate, lToDate, lFromStaff, lToStaff, lFromBranch, lToBranch, lErrorString, lErrorModule) = False Then
rtnErrorString = "Error setting default ranges : " & lErrorString
rtnErrorModule = "SetDefaultRanges (via " & lErrorModule & ")"
End If
End If
If rtnErrorString = "" Then
If ProcessBatchObject.AddRange(lFromInvoiceNo, lToInvoiceNo, lFromDebtor, lToDebtor, True, lFromDate, lToDate, lFromStaff, lToStaff, lFromBranch, lToBranch, "", False, -1, -1, -1, -1) = 0 Then
rtnErrorString = "Error adding a range of invoices : " & ProcessBatchObject.ErrorString
rtnErrorModule = ProcessBatchObject.ErrorModule
End If
End If
If rtnErrorString = "" Then
PrintingOptions = 0 ' bitwise field 1 = print invoice, 2 = print deldocket, 3 = print pack slip, 4 = print pick sheet, 5 = print other
' to print invoices, set to 1
' to print del dockets, set to 2
' to print BOTH invoices and del dockets, set to 3
If ProcessBatchObject.SaveRecord(PrintingOptions) = 0 Then
rtnErrorString = "Error processing invoices : " & ProcessBatchObject.ErrorString
rtnErrorModule = ProcessBatchObject.ErrorModule
End If
End If
If Not (ProcessBatchObject Is Nothing) Then
ProcessBatchObject.CleanUp
Set ProcessBatchObject = Nothing
End If
If Not (SystemProfileObject Is Nothing) Then
SystemProfileObject.CleanUp
Set SystemProfileObject = Nothing
End If
End Sub
Function SetDefaultRanges(DatabaseObject, FromInvoiceNo, ToInvoiceNo, FromDebtor, ToDebtor, FromDate, ToDate, FromStaff, ToStaff, FromBranch, ToBranch, ErrorString, ErrorModule)
Dim WorkStr
SetDefaultRanges = True
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "InvoiceNo", "SO_Main", " SO_Main.DocType = 1 ", 0, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
FromInvoiceNo = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "InvoiceNo", "SO_Main", " SO_Main.DocType = 1 ", 1, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
ToInvoiceNo = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "AccountNo", "DB_Main", "", 0, ErrorString,lErrorModule, WorkStr)
If SetDefaultRanges = True Then
FromDebtor = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "AccountNo", "DB_Main", "", 1, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
ToDebtor = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "RecordDate", "SO_History", "", 0, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
FromDate = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "RecordDate", "SO_History", "", 1, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
ToDate = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "SName", "HR_Staff", "", 0, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
FromStaff = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "SName", "HR_Staff", "", 1, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
ToStaff = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "Description", "SY_Branch", "", 0, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
FromBranch = WorkStr
End If
End If
If SetDefaultRanges = True Then
WorkStr = ""
SetDefaultRanges = ReadSQL(DatabaseObject, "Description", "SY_Branch", "", 1, ErrorString, ErrorModule, WorkStr)
If SetDefaultRanges = True Then
ToBranch = WorkStr
End If
End If
End Function
Function ReadSQL(DatabaseObject, FieldName, TableName, FilterString, Mode, ErrorString, ErrorModule, ReturnValue)
Dim SQL
Dim rHwnd
ReadSQL = True
If Mode <> 0 Then
SQL = "SELECT MAX(" & FieldName & ") FROM " & TableName & " "
Else
SQL = "SELECT MIN(" & FieldName & ") FROM " & TableName & " "
End If
If Len(FilterString) <> 0 Then
SQL = SQL & " WHERE " & FilterString
End If
With DatabaseObject
rHwnd = .StatementOpen(.ConnectionJiwaRead1, , , 1)
If .ExecuteSelect(CInt(rHwnd), SQL, True) = True Then
If .FetchRow(CInt(rHwnd)) Then
ReturnValue = .GetData(CInt(rHwnd), 1)
Else
ReadSQL = False
ErrorString = "No data found. (" & SQL & ")"
ErrorModule = "ReadSQL"
End If
Else
ReadSQL = False
ErrorString = .ErrorMessage
ErrorModule = "ReadSQL"
End If
.StatementClose CInt(rHwnd)
End With
End Function