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 *****
' ************************************