RNJarvis
9/26/2019 - 4:09 PM

Create Documents From Pages & Route them to a new Batch Class

This script demonstrates how to take specific pages from within one document and then create new KTM documents with a specific class name. These documents are then routed to a new batch class. All during Batch_Close.

Triggering routines: BeginCreateCherishedItemDocuments BnymDocumentRouting



' ************************************
' *** Cherished Item Routing Start ***
' ************************************

Private Sub BeginCreateCherishedItemDocuments(ByVal pXRootFolder As CASCADELib.CscXFolder, ByVal CloseMode As CASCADELib.CscBatchCloseMode)
   On Error GoTo ErrorHandler
   OutputDebugString "Scansation.BeginCreateCherishedItemDocuments"

   Dim i As Long
   Dim strBatchType As String

   If CloseMode = CscBatchCloseFinal And Project.ScriptExecutionMode = CscScriptModeValidation Then

      strBatchType = pXRootFolder.Fields.ItemByName("BatchType").Text
      For i  = 0 To pXRootFolder.DocInfos.Count - 1
         If pXRootFolder.DocInfos(i).XDocument.ExtractionClass <> "Batch Header" Then
            CreateCherishedItemDocumentsFromXDocInfo pXRootFolder.DocInfos(i), strBatchType
         End If
      Next

   End If

Exit Sub
ErrorHandler:
   LogError(Err.Number, "BeginCreateCherishedItemDocuments", Err.Description)
End Sub

Private Sub CreateCherishedItemDocumentsFromXDocInfo(ByVal oXDocInfo As CscXDocInfo, ByVal strBatchType As String)
   On Error GoTo ErrorHandler
   OutputDebugString "Scansation.CreateCherishedItemDocumentsFromXDocInfo"

   Dim strAllIndexes As String
   Dim arrAllIndexes() As String
   Dim i As Long
   Dim j As Long
   Dim k As Long
   Dim lStartIndex As Long
   Dim lEndIndex As Long
   Dim oXdoc As CscXDocument
   Dim oNewXDocInfo As CscXDocInfo
   Dim strOriginalIndexes As String
   Dim strCertCopyIndexes As String
   Dim strPhotoCopyIndexes As String
   Dim bCopiedFirstPage As Boolean
   Dim strNewClassName As String

   Set oXdoc = oXDocInfo.XDocument

   strOriginalIndexes = oXdoc.Fields.ItemByName("DetectedPageIndexes_ORIGINAL").Text
   strCertCopyIndexes = oXdoc.Fields.ItemByName("DetectedPageIndexes_CERTCOPY").Text
   strPhotoCopyIndexes = oXdoc.Fields.ItemByName("DetectedPageIndexes_PHOTOCOPY").Text

   strAllIndexes = strOriginalIndexes & IIf(strCertCopyIndexes <> "",",", "") & _
                   strCertCopyIndexes & IIf(strPhotoCopyIndexes <> "",",", "") & _
                   strPhotoCopyIndexes
   arrAllIndexes = Split(strAllIndexes, ",")
   QuickSort arrAllIndexes, 0, UBound(arrAllIndexes)

   strOriginalIndexes = "," & strOriginalIndexes & ","
   strCertCopyIndexes = "," & strCertCopyIndexes & ","

   For i = 0 To UBound(arrAllIndexes)
      lStartIndex = CLng(arrAllIndexes(i)) + 1

      If i = UBound(arrAllIndexes) Then
         lEndIndex = oXDocInfo.PageCount - 1

         If strBatchType <> "SFTP" Then
            lEndIndex = lEndIndex - 1
         End If
      Else
         lEndIndex = CLng(arrAllIndexes(i + 1)) - 1
      End If

      Dim strFilePaths As String
      Dim arrFilePaths() As String

      bCopiedFirstPage = False
      For j = lStartIndex To lEndIndex
         If Not bCopiedFirstPage Then
            Batch.CopyPageToNewDocumentTo oXDocInfo, j, oXdoc.ParentFolder, oXdoc.ParentFolder.DocInfos.Count
            Set oNewXDocInfo = oXdoc.ParentFolder.DocInfos.ItemByIndex(oXdoc.ParentFolder.DocInfos.Count - 1)
            bCopiedFirstPage = True
         Else
            Batch.CopyPageTo oXDocInfo, j, oNewXDocInfo, oNewXDocInfo.XDocument.Pages.Count
         End If
      Next

      If InStr(1, strOriginalIndexes, "," & arrAllIndexes(i) & ",") > 0 Then
         strNewClassName = "ORIGINAL"
      ElseIf InStr(1, strCertCopyIndexes, "," & arrAllIndexes(i) & ",") > 0 Then
         strNewClassName = "CERTCOPY"
      Else
         strNewClassName = "PHOTOCOPY"
      End If

      Batch.ChangeClass strNewClassName, oNewXDocInfo, True
      oNewXDocInfo.XDocument.Fields.ItemByName("HRN").Text = oXDocInfo.XDocument.Fields.ItemByName("HRN").Text

   Next
Exit Sub
ErrorHandler:
   LogError(Err.Number, "CreateCherishedItemDocumentsFromXDocInfo", Err.Description)
End Sub

Private Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

Public Sub BnymDocumentRouting(ByVal pXRootFolder As CASCADELib.CscXFolder)
   On Error GoTo ErrorHandler
   OutputDebugString "Scansation.BnymDocumentRouting"

   Dim i As Long
   Dim oXDocInfo As CASCADELib.CscXDocInfo
   Dim lPageIndex As Long
   Dim strNewBatchName As String

   For i = 0 To pXRootFolder.GetTotalDocumentCount() - 1
      Set oXDocInfo = pXRootFolder.GetDocInfoByGlobalIndex(i)

      Select Case oXDocInfo.XDocument.ExtractionClass
      Case "ORIGINAL", "CERTCOPY", "PHOTOCOPY"
         oXDocInfo.XValues.Set("KTM_DOCUMENTROUTING", "CherishedItem")
      End Select

      If oXDocInfo.XDocument.Fields.Exists("HRN") Then
         oXDocInfo.XValues.Set("SS_BNYM_HRN", oXDocInfo.XDocument.Fields.ItemByName("HRN").Text)
      End If
      oXDocInfo.XValues.Set("SS_BNYM_ItemType", oXDocInfo.XDocument.ExtractionClass)

   Next

   pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_NEWBATCHCLASS_CherishedItem", "BNYM Cherished Items")
   strNewBatchName = pXRootFolder.XValues("AC_BATCH_NAME") & " - Cherished Items"
   pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_BATCHNAME_CherishedItem", strNewBatchName)


Exit Sub
ErrorHandler:
   LogError(Err.Number, "BnymDocumentRouting", Err.Description)
End Sub


' ************************************
' *** Cherished Item Routing End *****
' ************************************