Jiwa

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