Scheduled Script to process sales orders

Find general Jiwa support here.

Scheduled Script to process sales orders

Postby Mike.Sheen » 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!

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
Mike Sheen
Chief Software Engineer
Jiwa Financials

If I do answer your question to your satisfaction, please mark it as the post solving the topic so others with the same issue can readily identify the solution
User avatar
Mike.Sheen
Overflow Error
Overflow Error
 
Posts: 2440
Joined: Tue Feb 12, 2008 11:12 am
Location: Perth, Republic of Western Australia
Topics Solved: 755

Return to Core Product Support

Who is online

Users browsing this forum: No registered users and 1 guest

cron