Digit Grouping
If Len(FieldText) = 0 Then
ValidFormat = False
ErrDescription = "Field must not be empty"
Else
FieldText = Replace(FieldText, " ", "") 'remove all spaces
If Len(FieldText) = 4 Then
FormattedText = Format(FieldText,"# ###") '1 000
ElseIf Len(FieldText) = 5 Then
FormattedText = Format(FieldText,"## ###") '10 000
ElseIf Len(FieldText) = 6 Then
FormattedText = Format(FieldText,"### ###") '100 000
ElseIf Len(FieldText) = 7 Then
FormattedText = Format(FieldText,"# ### ###")'1 000 000
ElseIf Len(FieldText) = 8 Then
FormattedText = Format(FieldText,"## ### ###")'10 000 000
ElseIf Len(FieldText) = 9 Then
FormattedText = Format(FieldText,"### ### ###")'100 000 000
Else
FormattedText = FieldText
End If
End If
Private Sub Document_BeforeExtract(ByVal pXDoc As CASCADELib.CscXDocument)
Dim pFRSettings As MPSFRLib.MpsPageRecogProfileFR
' replace "FineReader" in the next line with the name of the recognition profile
Set pFRSettings = Project.RecogProfiles.ItemByName("FineReader")
' disable FineReader fast mode here
' this is not available at the ProjectBuilder UI
pFRSettings.FastMode = False
End Sub
Dim pXRootFolder As CASCADELib.CscXFolder
Set pXRootFolder = pXDoc.ParentFolder
Dim sUser As String
sUser = pXRootFolder.XValues("AC_BATCH_OPERATORUSERID")
' Använd nedanstående om Domännamnet ska bort
If InStr(1,sUser,"\")>1 Then
sUser = Right(sUser,Len(sUser)-InStr(1,sUser,"\"))
End If
' För att få information om den inloggade användaren
' Exempel: Kofax Batch Field "Löpnummer" och KTM Field "Löpnummer"
' se till att ha unika namn för batch fält resp. index fält
' Se även till att ha kryssat i "Populate all index fields for read-only access in script"
Dim pXRootFolder As CASCADELib.CscXFolder
Set pXRootFolder = pXDoc.ParentFolder
pXDoc.Fields.ItemByName("Löpnummer").Text = pXRootFolder.XValues("AC_FIELD_Löpnummer")
Copy documentindex fields data to KTM (loop)
Den loopar igenom alla indexfält från KC och om de innehåller data och det finns ett motsvarande fältnamn i KTM så hamnar det där.
Man får anropa koden från lämplig plats, t.ex. ValidationForm_DocumentLoaded
Public Sub CaptureFieldsToKTMFields(pXDoc As CscXDocument)
Dim lCount As Long
For lCount = 0 To pXDoc.Fields.Count - 1
Dim Key As String
Key = "AC_FIELD_" & pXDoc.Fields.ItemByIndex(lCount).Name
If pXDoc.XValues.ItemExists(Key) Then
pXDoc.Fields.ItemByIndex(lCount).Text = pXDoc.XValues.ItemByName(Key).Value
End If
Next
End Sub
Function to get KC index field
Public Function GetKCindexfield(FieldName As String, pXDoc As CscXDocument)
Dim Key As String
Key = "AC_FIELD_" & FieldName
If pXDoc.XValues.ItemExists(Key) Then
GetKCindexfield = pXDoc.XValues.ItemByName(Key).Value
End If
End Function
’use in Document Before Extract
GetKCindexfield("<KCindexfieldName>",pXDoc)
Or just use below directly in Document_Before_Extract
pXDoc.XValues.ItemByName("Key").Value
Dim pXRootFolder As CASCADELib.CscXFolder
Set pXRootFolder = pXDoc.ParentFolder
' Variabel för antal dokument i en batch. Kan dock bli felaktigt om man raderar dokument i Validation Modulen.
' Förutsätter att Index Fält t.ex. "AntalDokument" finns.
pXDoc.Fields.ItemByName("AntalDokument").Text = CStr(pXRootFolder.GetTotalDocumentCount)
Save the Snippet of a Format Locator as a TIFF File
A Format Locator searches for a value on a Document. A Script Locator checks whether there is at least one value (alternative) found. If so, it creates an image in C:\Temp\.
Private Sub SL_LocateAlternatives(ByRef pXDoc As CASCADELib.CscXDocument, ByRef pLocator As CASCADELib.CscXDocField)
Dim image As CscImage
Dim field As CscXDocFieldAlternative
Dim image2 As New CscImage
Dim matchPage As Long
If pXDoc.Locators.ItemByName("FL").Alternatives.Count > 0 Then
Set field = pXDoc.Locators.ItemByName("FL").Alternatives.ItemByIndex(0)
matchPage = pXDoc.Locators.ItemByName("FL").Alternatives.ItemByIndex(0).PageIndex
Set image = pXDoc.CDoc.Pages(matchPage).GetImage
image2.CreateImage(CscImgColFormatBinary, field.Width, field.Height, _
image.XResolution, image.YResolution)
image2.CopyRect(image, field.Left, field.Top, 0, 0, field.Width, field.Height)
image2.Save("C:\Temp\Snipped1.tif", CscImgFileFormatTIFFFaxG4)
End If
End Sub
'Executing without waiting for the command to finish:
Private Sub ExecuteCommandWithoutWaiting(Command As String, ShowWindow As Boolean)
If ShowWindow Then
Shell(Command, vbNormalFocus)
Else
Shell(Command, vbHide)
End If
End Sub
'Executing with waiting for the command to finish:
Private Const WAIT_INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub ExecuteCommandWithWaiting(Command As String, ShowWindow As Boolean)
Dim hProcess As Long
Dim TaskId As Long
If ShowWindow Then
TaskId = Shell(Command, vbNormalFocus)
Else
TaskId = Shell(Command, vbHide)
End If
hProcess = OpenProcess(SYNCHRONIZE, True, TaskId)
Call WaitForSingleObject(hProcess, WAIT_INFINITE)
CloseHandle hProcess
End Sub
Calculate a total for two amount fields
Dim l_TaxAmount, l_TaxAmount1, l_TaxAmount2 As Double
DefaultAmountFormatter.FormatField (pXDoc.Fields.ItemByName("TaxAmount1"))
DefaultAmountFormatter.FormatField (pXDoc.Fields.ItemByName("TaxAmount2"))
Let l_TaxAmount1 = CDbl(pXDoc.Fields.ItemByName("TaxAmount1").Text)
Let l_TaxAmount2 = CDbl(pXDoc.Fields.ItemByName("TaxAmount2").Text)
Let l_TaxAmount = l_TaxAmount1 + l_TaxAmount2
Let pXDoc.Fields.ItemByName("TaxAmount").Text = Format(l_TaxAmount, "0.00")
DefaultAmountFormatter.FormatField (pXDoc.Fields.ItemByName("TaxAmount"))
Database queries using native KTM script
The following code assumes a relational database has been defined in Project Settings named "TestDB" which points to a relational database table with columns NAME and ID:
'get database set in Project Settings
Dim db As CscDatabase
Set db = Project.Databases.ItemByName("TestDB")
'Create query
Dim query As CscSQLQuery
Set query = db.SQLTable.CreateQuery
'Set where clause
query.SetCustomWhere("ID=1") 'with string query.SetCustomWhere("Name = ‘Bill’")
'run query
Dim Result As CscSQLRecordset
Set Result=query.ExecuteQuery
'get rows
Dim rows As CscSQLRows
Set rows = Result.Rows
'if the query returns one result, display msgbox with the name
If rows.Count = 1 Then
Dim row As CscSQLRow
Set row = rows.ItemByIndex(0)
MsgBox "Name column is" & row.CellByName("NAME").Value
End If
If Len(pField.Text) > 0 Then
Dim RegEx As New RegExp, Matches As MatchCollection
RegEx.Pattern = "\d{3,4}[-]\d{4}"
Set Matches = RegEx.Execute(pField.Text)
If Matches.Count > 0 Then
FormattedText = Matches.Item(0)
ValidFormat = True
Else
pField.Text = ""
pField.Confidence = 0
End If
End If
Skapa tre Locators i nedan ordning.
1. AnchorLocator
2. ScriptLocator
3. ZoneLocator
AnchorLocator:
Skapa en Format Locator som du letar upp en bra Anchor Zone som är precis ovan eller bredvid ditt värde du vill ta ut.
Scriptlocator:
Lägg in nedan script
Private Sub ScriptLocator_LocateAlternatives(pXDoc As CASCADELib.CscXDocument, pLocator As CASCADELib.CscXDocField)
Dim AnchorField As CscXDocField
Dim AnchorFieldAlternative As CscXDocFieldAlternative
Dim Rep As CscXDocRepresentation
Dim Zone As CscXDocZone
Dim i As Integer
' get the first alternative from the anchor locator (Format Locator in this sample)
If Not pXDoc.Locators.Exists("AnchorLocator") Then Exit Sub
' we are now manually "executing" the locator and store the results to a field
Set AnchorField = pXDoc.Locators.ItemByName("AnchorLocator")
If AnchorField.Alternatives.Count = 0 Then Exit Sub
' we are setting the anchor field alternative to be the fields (that we have created above) first alternative
Set AnchorFieldAlternative = AnchorField.Alternatives(0)
' get representation to store zone position
If pXDoc.Representations.Count = 0 Then Exit Sub
Set Rep = pXDoc.Representations(0)
' check if zone position already exists (if image extracted multiple times in the project builder)
For i = 0 To Rep.Zones.Count - 1
Set Zone = Rep.Zones(i)
' checking if the "MyNewZone" already exists - the zone from the advanced zone locator which is present inside the collectionCscXDocRepesenatation
If Zone.Name = "MyNewZone" Then
Rep.Zones.Remove(i)
Exit For
End If
Next
' create new zone position - edit everything that you would need to edit!
Set Zone = New CscXDocZone
Zone.Name = "MyNewZone"
Zone.Left = AnchorFieldAlternative.Left
' let the zone start right below the barcode
Zone.Top = AnchorFieldAlternative.Top + AnchorFieldAlternative.Height
Zone.Width = AnchorFieldAlternative.Width
' set the zone height to 40 pixels
Zone.Height = 40
Zone.PageNr = AnchorFieldAlternative.PageIndex
Rep.Zones.Append Zone
End Sub
ZoneLocator:
Gå in i locatorn och skapa en ny zon med namnet “MyNewZone” och ställ in properties som du vill ha dessa, vi ändrar bara position och storlek på zonen.
Koppla sedan ditt indexfält till sub field "SF_MyNewZone"
'Skapa först en function som du sedan anropar
Public Function FillLeft(ByVal sToFill As String, ByVal lLen As Long, ByVal sFill As String) As String
On Error GoTo PROC_ERR
Const cProcName = "FillLeft"
Dim sResult As String
sResult = sToFill
While Len(sResult) < lLen
sResult = sFill & sResult
Wend
FillLeft = sResult
PROC_EXIT:
Exit Function
PROC_ERR:
Resume PROC_EXIT
End Function
'pad left with leading zeros to 4 digits
pField.Text = FillLeft(pField.Text, 4, "0")
Blank Out regions on image with lasso
Private Sub ValidationForm_AfterViewerLassoDrawn(ByVal pXDoc As CASCADELib.CscXDocument, ByVal PageIndex As Long, ByVal pField As CASCADELib.CscXDocField, ByVal TopPos As Long, ByVal LeftPos As Long, ByVal Width As Long, ByVal Height As Long, ByRef bCancel As Boolean)
Select Case pField.Name
Case "InvoiceNumber"
Dim oImage As CscImage
Set oImage = pXDoc.CDoc.Pages(PageIndex).GetImage()
oImage.EraseRect(LeftPos, TopPos, Width, Height)
oImage.Save(oImage.FileName, CscImgFileFormatTIFFFaxG4)
pXDoc.Reclassify pXDoc.ExtractionClass
End Select
End Sub
Change positiv amount to negativ in a table
' Kod för att ändra positiva belopp till negativa i en tabell om det är en kreditfaktura. Notera att cellnumreringen kan variera beroende på tabellkonstruktionen
Dim t As Integer
If pXDoc.Fields.ItemByName("InvoiceType").Text = "K" Then
If pXDoc.Fields.ItemByName("OrderRader").Table.Rows.Count > 0 Then
For t=0 To pXDoc.Fields.ItemByName("OrderRader").Table.Rows.Count-1
If Left(pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(3).Text,1) <> "-" Then
pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(3).Text = "-" + pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(3).Text
End If
If pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(2).Text = "1.00" Then
pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(2).Text = "1"
End If
Next
End If
End If
Change x.0 or x.00 to a complete amount
' Kod för att ändra x.0 eller x.00 till heltal. Om det är decimaler som inte är .00 (t.ex. 2.25) så påverkas dem ej
For t=0 To pXDoc.Fields.ItemByName("OrderRader").Table.Rows.Count-1
If Right(pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(2).Text,3) = ".00" Or Right(pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(2).Text,2) = ".0" Then
pXDoc.Fields.ItemByName("OrderRader").Table.Rows(t).Cells(2).Text = "1"
End If
Next
Compare total with total in a table
' jämföra Totalbeloppet från tabellen med Totalbeloppet (minus moms) på fakturan. Om det skiljer sig ska Total bli "invalid"
Dim oTotal As Double
Dim iTotal As Double
Dim Dif As Double
Dim c As Integer
If pXDoc.Fields.ItemByName("OrderRader").Table.Rows.Count > 0 Then
For c=0 To pXDoc.Fields.ItemByName("OrderRader").Table.Rows.Count-1
oTotal = oTotal + Val(pXDoc.Fields.ItemByName("OrderRader").Table.Rows(c).Cells(7).Text)
Next c
iTotal = Val(pXDoc.Fields.ItemByName("Total").Text) - Val(pXDoc.Fields.ItemByName("TaxAmount").Text)
Dif = iTotal - oTotal
If Dif < -1 Or Dif > 1 Then
pXDoc.Fields.ItemByName("Total").ExtractionConfident = False
End If
Dif = Round(Dif)
pXDoc.Fields.ItemByName("Differens").Text = CStr(Dif)
End If
Create a message box with YES,NO
'Varna ifall det är ett UC ORGnummer
If pField.Text = "556137-5113" Then
Dim answer As Integer
answer = MsgBox("OBS vill du spara ändå?", vbYesNo + vbQuestion + vbDefaultButton2, "OBS!!!")
If answer = vbYes Then
pXDoc.Fields.ItemByName("VatID").Valid = True
pXDoc.Fields.ItemByName("VatID").ExtractionConfident = True
Else
pXDoc.Fields.ItemByName("VatID").Valid = False
pXDoc.Fields.ItemByName("VatID").ExtractionConfident = False
End If
End If
Sticky Values with Script variables
Private Sub ValidationForm_DocumentLoaded(ByVal pXDoc As CASCADELib.CscXDocument)
If Project.ScriptVariables.ItemByName("StickyAvtalsNr").Value <> "" Then
pXDoc.Fields.ItemByName("AvtalsNr").Text = Project.ScriptVariables.ItemByName("StickyAvtalsNr").Value
End If
Private Sub Document_Validated(ByVal pXDoc As CASCADELib.CscXDocument)
Project.ScriptVariables.ItemByName("StickyAvtalsNr").Value = pXDoc.Fields.ItemByName("AvtalsNr").Text
End Sub
Use batch Open/Close event in KTM
Private Sub Batch_Close(ByVal pXRootFolder As CASCADELib.CscXFolder, ByVal CloseMode As CASCADELib.CscBatchCloseMode)
SetDokTypVar(pXRootFolder,CloseMode)
End Sub
Private Sub SetDokTypVar(ByVal pXRootFolder As CASCADELib.CscXFolder, ByVal CloseMode As CASCADELib.CscBatchCloseMode)
'If we are in KTM Validation and have a closed batch
If Project.ScriptExecutionMode = CscScriptModeValidation And CloseMode = CscBatchCloseFinal Then
Project.ScriptVariables.ItemByName("DokTypVar").Value = "Avtal"
Project.ScriptVariables.ItemByName("StickyAvtalsNr").Value = ""
End If
Project.ValidateAfterBatchRestructuring = False 'måste vara med för att inte hamna tillbaka i validering
End Sub
Batch open event
Private Sub Batch_Open(ByVal pXRootFolder As CASCADELib.CscXFolder)
SetMyValue (pXRootFolder)
End Sub
Private Sub SetMyValue(ByVal pXRootFolder As CASCADELib.CscXFolder)
Project.ScriptVariables.ItemByName("DokTypVar").Value = "MyValue"
End Sub
Prevent error in KTM with 96 DPI or lower
Private Sub Document_BeforeClassifyImage(ByVal pXDoc As CASCADELib.CscXDocument, ByVal PageNr As Long,ByRef bSkip As Boolean)
Dim oImage As CscImage
Set oImage = pXDoc.CDoc.Pages.ItemByIndex(PageNr).GetImage()
'The check if the resolution of this image is too low for the image classifier to process it.
If oImage.XResolution < 96 Or oImage.YResolution < 96 Then
'Set bSkip to true to prevent the layout classifier from causing an error.
bSkip = True
'If content or instruction classification is enabled
' they will still run after this and may classify the document.
'In a project with only layout classification
' it will go to the default class or be unclassified.
End If
End Sub
Funktion för att kontrollera Svenskt ORG nummer (VAT) eller personnummer
Om man ska kolla personnummer får man inte ta med århundradet. (Scripta det i funktionen.)
Call Mod10 pXDoc,pField
Private Function Mod10(ByVal pXDoc As CASCADELib.CscXDocument, ByVal pField As CASCADELib.CscXDocField)
On Error GoTo ScriptError
' Function to check if a swedish VAT ID is correct. (Same algorithm as for personnummer.)
Dim i As Integer
Dim TotalOdd As Integer
Dim TotalEven As Integer
Dim Total As Integer
Dim TotaloddString As String
Dim TotalEvenString As String
Dim TotalString As String
Dim Value As String
' Uncomment the below 3 lines if Mod10 has to be checked and never overridden
If pField.ForcedValid = True Then
Exit Function
End If
Value = Trim(pField.Text)
Value=Replace(Value,"-","")
Value=Replace(Value," ","")
If IsNumeric(Value) Then
Total = 0
'get odd numbers starting with the second to last digit (ignoring the check digit)
For i = Len(Value)-1 To 1 Step -2
TotalOdd = CInt(Mid(Value, i, 1) * 2)
TotaloddString = TotaloddString & CStr(TotalOdd)
Next i
i = 0
TotalOdd = 0
For i = 1 To Len(TotaloddString)
TotalOdd = TotalOdd + CInt(Mid(TotaloddString, i, 1))
Next i
'get even numbers starting with the third to last digit (ignoring the check digit)
i = 0
For i = Len(Value)-2 To 1 Step -2
TotalEvenString = TotalEvenString & (Mid(Value, i, 1))
Next i
For i = 1 To Len(TotalEvenString)
TotalEven = TotalEven + CInt(Mid(TotalEvenString, i, 1))
Next i
Total = TotalOdd + TotalEven
TotalString =CStr(Total)
TotalString=Right(TotalString,1)
Total=10-CInt(TotalString)
If Right(Value, 1) = Right(CStr(Total),1) Then
pField.ExtractionConfident=True
pField.Valid=True
pField.ErrorDescription=""
Else
pField.ExtractionConfident=False
pField.ErrorDescription="Felaktigt nummer. Checksiffran stämmer ej"
End If
Else
pField.ExtractionConfident = False
pField.ErrorDescription = "Kontrollera siffrorna"
End If
ScriptExit:
Exit Function
ScriptError:
pField.ExtractionConfident = False
pField.ErrorDescription = "Scriptfel! Ta kopia på fakturan och rapportera till Canon. Kontrollera data noggrant i detta fält."
Resume ScriptExit
End Function
SQL Connection via Microsoft ADO
First you need to add a reference to MS-ADO to the script for every class the database is being used with:
Add "Microsoft ActiveX Data Objects 6.1 Library (6.1)"
=====================================================
Different connection strings:
Direct to SQL: "Provider=xxxxx;Server=WIN7\SQLEXPRESS;Database=CSVSQL;Uid=kofax;Pwd=kofaxpass;"
Via ODBC: "DSN=myODBCname" (need to have an ODBC set up first with that name)
=====================================================
Different providers:
Provider=SQLNCLI11 (old driver)
Provider=MSOLEDBSQL (SQL2012 - SQL 2019) (must have new C++ runtimes x86 + x64), (link to OLE DB driver)
************************************************************************************
Dim m_DatabaseConnection As ADODB.Connection
Const m_ConnectionString1 As String = "Provider=SQLNCLI11;Server=WIN7\SQLEXPRESS;Database=CSVSQL;Uid=kofax;Pwd=kofaxpass;"
************************************************************************************
Public Function GetDatabaseConnection() As ADODB.Connection
If Not m_DatabaseConnection Is Nothing Then
Set GetDatabaseConnection = m_DatabaseConnection
Exit Function
End If
On Error GoTo ConnectionFailed
Set m_DatabaseConnection = New ADODB.Connection
m_DatabaseConnection.ConnectionString = m_ConnectionString1
m_DatabaseConnection.Open
Set GetDatabaseConnection = m_DatabaseConnection
Exit Function
ConnectionFailed:
Set m_DatabaseConnection = Nothing
Set GetDatabaseConnection = Nothing
End Function
************************************************************************************
Private Sub Document_AfterExtract(pXDoc As CASCADELib.CscXDocument)
On Error GoTo ConnectionFailed
Dim DatabaseConnection As ADODB.Connection
Dim SQL As String
Dim Cmd As ADODB.Command
Dim Param As ADODB.Parameter
Dim Recordset As ADODB.Recordset
Set DatabaseConnection = GetDatabaseConnection
If DatabaseConnection Is Nothing Then
' error
Exit Sub
End If
' **********retrieve data **********************
SQL = "SELECT top 1 AccountOwner FROM CSVSQL.dbo.CSVTest where SFDCNumber = '" & pXDoc.Fields.ItemByName("Total").Text & "'"
Set Recordset = DatabaseConnection.Execute(SQL)
MsgBox(Recordset(0))
ConnectionFailed:
Set DatabaseConnection = Nothing
End Sub
First add a reference to:
Windows Script Host Object Model(1.0)
Dim objShell, strTemp
Set objShell = CreateObject("WScript.Shell")
strTemp = "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Kofax Image Products\Ascent Capture\3.0\AppTitle"
pXDoc.Fields.ItemByName("Software").Text = objShell.RegRead(strTemp)
Change label text depending on the batch class name
Private Sub ValidationForm_DocumentLoaded(ByVal pXDoc As CASCADELib.CscXDocument)
Dim pXRootFolder As CASCADELib.CscXFolder
Set pXRootFolder = pXDoc.ParentFolder
If InStr(pXRootFolder.XValues("AC_BATCH_CLASS_NAME"), "Efter") <> 0 Then
ValidationForm.Labels.ItemByName("Label0").Text = "LF Södermanland Efterhand"
End If
Loop trough every document in batch open
Add script on the project level
In this script we add a counter to every document in a field
Private Sub Batch_Open(ByVal pXRootFolder As CASCADELib.CscXFolder)
SetCustomDocCounter(pXRootFolder) 'Call loop function
End Sub
Private Sub SetCustomDocCounter(ByVal pXRootFolder As CASCADELib.CscXFolder)
Dim i As Long
Dim pXDoc As CASCADELib.CscXDocument
'Check if we are in KTM Validation
If Project.ScriptExecutionMode = CscScriptModeValidation Then
'Loop through documents
For i = 0 To pXRootFolder.DocInfos.Count-1
' Get Doc and start collect data
Set pXDoc = pXRootFolder.DocInfos.ItemByIndex(i).XDocument
pXDoc.Fields.ItemByName("BatchClassify").Text = CStr(i)
Next
End If
End Sub
Med denna teknik så kan du styra vart på dokumentet du vill söka efter ord/fraser
I denna använder jag fyra olika locators, en för att hitta ett nummer, en för att hitta nummer som är 90grader vridet och den sista för att hitta olika ord
Börja med att lägga till en reference för att kunna använda Regular Expression i script
Skapa sedan en nyckelordlista
Lägg till en scriptvariabel med namnet ClassifyValue
Skapa sedan fyra locators enligt nedan
Klistra in nedan script under projektnivån, i detta kan du ändra regular expression och vilken default class den ska hamna i vid error
Private Sub ClassifySL_LocateAlternatives(ByVal pXDoc As CASCADELib.CscXDocument, ByVal pLocator As CASCADELib.CscXDocField)
Project.ScriptVariables.ItemByName("ClassifyValue").Value = "" 'clear value
Dim DocTypeNo As String
'Check first DocNo
If pXDoc.Locators.ItemByName("ClassifyNo90").Alternatives.Count > 0 Then
DocTypeNo = GetDocType(pXDoc.Locators.ItemByName("ClassifyNo90").Alternatives.ItemByIndex(0).SubFields(0).Text)
If DocTypeNo <> "" Then
Project.ScriptVariables.ItemByName("ClassifyValue").Value = DocTypeNo
End If
End If
'Check second DocNo
If pXDoc.Locators.ItemByName("ClassifyNo").Alternatives.Count > 0 And DocTypeNo = "" Then
DocTypeNo = GetDocType(pXDoc.Locators.ItemByName("ClassifyNo").Alternatives(0).Text)
If DocTypeNo <> "" Then
Project.ScriptVariables.ItemByName("ClassifyValue").Value = DocTypeNo
End If
End If
'Word check here
If pXDoc.Locators.ItemByName("ClassifyWord").Alternatives.Count > 0 And DocTypeNo = "" Then
DocTypeNo = GetDocType(pXDoc.Locators.ItemByName("ClassifyWord").Alternatives(0).Text)
If DocTypeNo <> "" Then
Project.ScriptVariables.ItemByName("ClassifyValue").Value = DocTypeNo
End If
End If
End Sub
Public Function GetDocType(ByVal Value As String) As String
If Len(Value) > 0 Then
Dim RegEx As New RegExp, Matches As MatchCollection
RegEx.Pattern = "KAM\d{5}" 'Här kan du ändra till vad du vill ha
Set Matches = RegEx.Execute(Value)
If Matches.Count > 0 Then
GetDocType = Matches.Item(0)
Else
GetDocType = ""
End If
End If
End Function
Private Sub Document_BeforeClassifyXDoc(ByVal pXDoc As CASCADELib.CscXDocument, ByRef bSkip As Boolean)
On Error GoTo Reclassify
If Project.ScriptVariables.ItemByName("ClassifyValue").Value <> "" Then
pXDoc.Reclassify(Project.ScriptVariables.ItemByName("ClassifyValue").Value)
Exit Sub
End If
Reclassify:
pXDoc.Reclassify("Blankett")'Här kan du ändra till vad du vill ha
End Sub
If you want to format a field in script, you can use the following code:
Project.FieldFormatters.ItemByName("DefaultAmountFormatter").FormatField(pField)
You can user formatters directly as objects:
DefaultAmountFormatter.FormatField(pField)
And you can format cells of a table in the same way:
DefaultAmountFormatter.FormatCell(pField.Table.Rows(0).Cells(0))
för att tex. Söka på kund och få tillbaka ett kundnummer från en SQL databas.
Funktionen förutsätter I detta fallet att det finns en definierad database i “Project Settings” som heter “KunderDB”.
(se exempel nedan)
I denna databas finns column namnen ”KundNamn” och ”KundID”.
RKod och sKund är de variabler som används för att skicka resultatet till fält i KTM. I detta fallet förutsätter jag att jag bara får en träff. Om jag får flera så är lookupen ogiltig.
Databas i SQL servern
Databas koppling i Kofax KTM
nedan sida finns all kod som behövs för denna funktion
’================================= Start ==============================================
Private Function DBLookup(ByVal RKod As String, ByRef Kund As String) As Boolean
Dim db As CscDatabase
Dim dtb As CscSQLDataTable
Dim qry As CscSQLQuery
Dim rs As CscSQLRecordset
Dim rw As CscSQLRow
Dim cl As CscSQLCell
Set db = Project.Databases.ItemByName("KunderDB")
Set dtb = db.SQLTable
Set qry = dtb.CreateQuery()
qry.AddSelectField(dtb.FieldByName("KundNamn"))
qry.AddSelectField(dtb.FieldByName("KundID"))
qry.AddWhereField(dtb.FieldByName("KundNamn"), CscEqual, RKod)
Set rs = qry.ExecuteQuery
If rs.RecordCount = 0 Then
DBLookup = False
If rs.RecordCount > 1 Then
DBLookup = False
End If
Else
Set rw = rs.RowByIndex(0)
RKod = rw.CellByName("KundNamn").Value
Kund = rw.CellByName("KundID").Value
DBLookup = True
End If
End Function
’================================= END ===================================================
Nedan är koden för att anropa funktionen
Anropa denna i tex. After Field Confirmed I fältet där du matade in kundnamn så slår den upp och fyller I KundID. Eller om du fylla i efter dokumentet blivit validerat, kan vara bra ifall ditt KundNamn fält alltid är ”grönt”
Så lägg detta i Dokument Validated
’========================= START =================================
Dim sRKod As String
Dim sKund As String
sRKod = pField.Text
If DBLookup(sRKod, sKund) = True Then
pXDoc.Fields.ItemByName("KundNamn").Text = sKund
pXDoc.Fields.ItemByName("KundID").Text = sRKod
Else
pXDoc.Fields.ItemByName("KundNamn").Text = ""
pXDoc.Fields.ItemByName("KundID").Text = ""
End If
‘============================ END =================================
Autofill a Combobox in script from a database
Initialize the DB is supposed to be called once per batch. Not every document, this is time consuming and make unnecessary calls
Here´s how you can do it
- Execute your call only once per batch in batch open
- Store the combobox items in a collection
- On the BeforeComboboxDropDown, call a custom function that populates the combobox with the items from the collection.
This function require a defined database in “Project Settings”
Add below code in the Project script
Private ComboBoxItemsArray As Object
' Project Script
Private Sub Batch_Open(ByVal pXRootFolder As CASCADELib.CscXFolder)
Dim ColumnName, DBname As String
ColumnName = "KundNamn" 'Column name in database
DBname = "DocTypes" 'Database name in KTM Project Builder
Set ComboBoxItemsArray = CreateObject("System.Collections.ArrayList")
Dim SQLDataTable As CscSQLDataTable, SQLQuery As CscSQLQuery
Dim r As Long, Recordset As CscSQLRecordset
Set SQLDataTable = Project.Databases.ItemByName(DBname).SQLTable
Set SQLQuery = SQLDataTable.CreateQuery()
SQLQuery.AddSelectField(SQLDataTable.FieldByName(ColumnName))
'SQLQuery.AddWhereField(SQLDataTable.FieldByName("ColumnName"), CscEqual, "123")
Set Recordset = SQLQuery.ExecuteQuery()
For r = 0 To Recordset.RecordCount-1
With Recordset.RowByIndex(r).Cells
'Add result in Array
ComboBoxItemsArray.Add(Recordset.RowByIndex(r).CellByName(ColumnName).Value)
End With
Next
ComboBoxItemsArray.Sort
End Sub
Public Function GetComboboxItemsArray(separator As String) As String
Dim i As Long
Dim cbxItems As String
cbxItems = ""
For i = 0 To ComboBoxItemsArray.Count -1
cbxItems += ComboBoxItemsArray(i) & separator
Next
' omit the last separator char
GetComboboxItemsArray = Left(cbxItems, Len(cbxItems) - 1)
End Function
Then add below code in a class script e.g BeforeComboboxDropdown to initialize before you go into the combobox
Private Sub ValidationForm_BeforeComboBoxDropDown(ByVal ComboboxName As String, ByVal pXDoc As CASCADELib.CscXDocument, ByRef ComboBoxItems As String)
Select Case ComboboxName
Case "DocTypes" 'name of the combobox
'Loop all results from the Array and add to combobox
ComboBoxItems = GetComboboxItemsArray(";") 'in the script test you get an error, don´t worry it will work in production.
End Select
End Sub
Black out by default when open a document
Function to black out part of document when opened in validation
Just call this function in document loaded with MaskDocArea(pXDoc)
Private Function MaskDocArea(ByVal pXDoc As CASCADELib.CscXDocument)
If Project.ScriptExecutionInstance = 1 Then
Dim oMaskingZone As CscScriptMaskedArea
Dim iNumberOfMaskingZones As Integer
Dim i As Integer
'first remove mask
For iNumberOfMaskingZones = ValidationForm.MaskedAreas.Count - 1 To 0 Step -1
ValidationForm.MaskedAreas.Remove(iNumberOfMaskingZones)
Next iNumberOfMaskingZones
' apply mask
For i = 0 To pXDoc.Pages.Count -1
Set oMaskingZone = ValidationForm.MaskedAreas.Create()
oMaskingZone.Left = 200
oMaskingZone.Top = 200
oMaskingZone.Height = pXDoc.CDoc.Pages.ItemByIndex(i).Height - 400
oMaskingZone.Width = pXDoc.CDoc.Pages.ItemByIndex(i).Width - 400
oMaskingZone.PageIndex = i
Next
End If
ValidationForm.Labels.ItemByName("lblMask").Text = "You are not allowed to validate this document" ValidationForm.Labels.ItemByName("lblMask").Visible = True ValidationForm.Labels.ItemByName("lblMask").SetForeColor(255,0,0) 'Set red text End Function
Split string
Dim MyString
MyString = "123;asd;AAAA;BBB;CCC" 'Detta är din sträng
Dim B
B = Split(MyString,";")(1) 'Ta värde nr 2 = asd
Dim C
C = Split(MyString,";")(2) 'ta värde nr 3 = AAAA
Document Separation in KTM
Private Sub Document_SeparateCurrentPage(ByVal pXDoc As CASCADELib.CscXDocument, ByVal PageNr As Long, ByRef bSplitPage As Boolean, ByRef RemainingPages As Long)
Dim oSinglePageDoc As CscXDocument
Set oSinglePageDoc = New CscXDocument
'Create a temporary document with a single page
oSinglePageDoc.CopyPages(pXDoc, PageNr, 1)
'Read from locator
Project.ClassByName("DocSep").Extract oSinglePageDoc
'If the text is found then split the document
If oSinglePageDoc.Fields.ItemByName("DocSep").Text = "xxxxxxx" Then
bSplitPage = True
Else
bSplitPage = False
End If
End Sub
Modulus 10 function with personnummer
Private Function Mod10Pno(ByVal number As String)
Dim ReturnLength, Separator, ErrorReturnMess
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''' This function return personnummer if checksum is correct
'''''''' number: personnummer (send in 10 or 12 digits with or without "-"
'''''''' Example how to call this function, Mod10Pno("19700102-1234")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ReturnLength = "12" 'If you would like to return 10 digits or 12 digits (Value:10 or 12)
Separator = "" 'use "-" if you want personnummer like "xxxxxxxx-yyy"
ErrorReturnMess = "Personnummer inte korrekt" 'value to return if personnummer is wrong or checksum is not correct
On Error GoTo ScriptError
Dim i, TotalOdd, TotalEven, Total As Integer
Dim TotaloddString, TotalEvenString, TotalString, Value, Century As String
Value = Trim(number)
Value=Replace(Value,"-","")
Value=Replace(Value," ","")
'Mod10 only handles 10 digits, remove century from personnummer
If Len(Value) = 12 Then
'check if century is 19 or 20
If Left(Value,2) = "19" Or Left(Value,2) = "20" Then
Century = Left(Value,2)
Value = Mid(Value, 3,10)
Else
'try correct century
If Mid(Value,3,2) >= Format(Now,"yy") Then
Value = Mid(Value, 3,10)
Century = "19"
Else
Century = "20"
End If
End If
Else
'try add century
If Mid(Value,3,2) >= Format(Now,"yy") Then
Value = Mid(Value, 3,10)
Century = "19"
Else
Century = "20"
End If
End If
If IsNumeric(Value) Then
Total = 0
'get odd numbers starting with the second to last digit (ignoring the check digit)
For i = Len(Value)-1 To 1 Step -2
TotalOdd = CInt(Mid(Value, i, 1) * 2)
TotaloddString = TotaloddString & CStr(TotalOdd)
Next i
i = 0
TotalOdd = 0
For i = 1 To Len(TotaloddString)
TotalOdd = TotalOdd + CInt(Mid(TotaloddString, i, 1))
Next i
'get even numbers starting with the third to last digit (ignoring the check digit)
i = 0
For i = Len(Value)-2 To 1 Step -2
TotalEvenString = TotalEvenString & (Mid(Value, i, 1))
Next i
For i = 1 To Len(TotalEvenString)
TotalEven = TotalEven + CInt(Mid(TotalEvenString, i, 1))
Next i
Total = TotalOdd + TotalEven
TotalString =CStr(Total)
TotalString=Right(TotalString,1)
Total=10-CInt(TotalString)
If Right(Value, 1) = Right(CStr(Total),1) Then
'Check is OK
If ReturnLength = "10" Then
Mod10Pno = Left(Value,6) + Separator + Mid(Value,7,10)
Else
Mod10Pno = Century + Left(Value,6) + Separator + Mid(Value,7,10)
End If
Else
Mod10Pno = ErrorReturnMess 'False return NULL
End If
Else
'False, not only digits, Return NULL
Mod10Pno = ErrorReturnMess
End If
ScriptExit:
Exit Function
ScriptError:
'False Error, return NULL
Mod10Pno = ErrorReturnMess
Resume ScriptExit
End Function
Rest call function
Call the function like this RestCall("197012019999", pXdoc)
Public Function RestCall(ByVal Pno As String, ByVal pXDoc As CASCADELib.CscXDocument)
Dim uri, response As String
Dim http As Object
Set http = CreateObject("MSXML2.ServerXMLHTTP")
uri = "http://localhost:8080/?PIN=" + Pno
http.Open("GET", uri, False)
' http.setRequestHeader "Authorization", "BASIC AUTH_STRING"
http.Send
response = http.responseText
Set http = Nothing
'Handle the respone here
End Function
Save document image with error message from validation
'First place a button and a text field on the validation form, then place the code under ValidationForm_ButtonClicked
Private Sub ValidationForm_ButtonClicked(ByVal ButtonName As String, ByVal pXDoc As CASCADELib.CscXDocument)
Select Case ButtonName
Case "Button0"
'Saves the image + txt file into CaptureSV\ReportedFiles
Dim Image As CscImage
Dim LastBackSlash, LastBackSlash2, LastBackSlash3, PageIndex As Integer
Dim ImagePath,ImagePath2, ImagePath3 As String
Dim FileSys, NewFolder, NewFolderPath
Dim MyFileName, ErrorMess As String
PageIndex = ValidationForm.CurrentPageIndex
Set Image = pXDoc.CDoc.Pages(PageIndex).GetImage
Set FileSys=CreateObject("Scripting.FileSystemObject")
ErrorMess = pXDoc.Fields.ItemByName("BadOCRmess").Text
MyFileName = Format(Now(), "yyyyMMddhhmmss")
LastBackSlash = InStrRev(Image.FileName,"\")
ImagePath2 = Left(Image.FileName,LastBackSlash -1)
LastBackSlash2 = InStrRev(ImagePath2,"\")
ImagePath3 = Left(Image.FileName,LastBackSlash2 -1)
LastBackSlash3 = InStrRev(ImagePath3,"\")
ImagePath = Left(ImagePath3,LastBackSlash3)
NewFolderPath = ImagePath & "ReportedFiles"
If Not FileSys.FolderExists(NewFolderPath) Then
Set NewFolder = FileSys.CreateFolder(NewFolderPath)
End If
'Save file to disk
Image.Save(NewFolderPath & "\" & MyFileName & ".tif")
'Write errormessage to file
Open NewFolderPath & "\" & MyFileName & ".txt" For Output As #1
Print #1, Environ("USERNAME") & "|" & ErrorMess
Close #1
'ValidationForm.Buttons.ItemByName("BtnSaveError").Enabled = False
' MsgBox("Image saved for analyze") 'If using web validation do not use message popup
End Select
End Sub
JSON get value function
The following code is very simple and reads values out of a JSON without concerning itself with the structure.
Private Function JSON_GetValue(JSON As String, Key As String, Optional Index As Long = 0)
'Add a reference to Microsoft VBScript Regular Expressions 5.5 in the Edit\References... Menu
'This returns a value from a JSON given the key.for the third element in an array set index=2
Dim Regex As New RegExp, Matches As MatchCollection
Regex.IgnoreCase = True
Regex.Global = True
Regex.Pattern = """" & Key & """\s*:\s*""(.*?)"""
Set Matches = Regex.Execute(JSON)
If Matches.Count>0 Then JSON_GetValue Matches.Item(Index).SubMatches(0)
End Function
Call a formatter through script
If you want to format a field in script, you can use the following code:
A:
Project.FieldFormatters.ItemByName("DefaultAmountFormatter").FormatField(pField)
B:
You can user formatters directly as objects:
DefaultAmountFormatter.FormatField(pField)
C:
Table cells can be formatted the same way:
DefaultAmountFormatter.FormatCell(pField.Table.Rows(0).Cells(0))
Kofax Capture batch values
The following batch properties are accessible from script (XRootFolder.XValues.ItemByName(XValue key)
Get value from script locator
Batch Property XValue key
Batch Name AC_BATCH_NAME
Batch Class Name AC_BATCH_CLASS_NAME
Priority AC_BATCH_PRIORITY
ImageDirectory AC_IMAGE_DIRECTORY
ExternalBatchID AC_EXTERNAL_BATCHID
BatchGUID AC_BATCH_GUID
BatchCreationDateTime AC_BATCH_CREATIONDATETIME
CreationSiteName AC_BATCH_CREATIONSITENAME
CreationUserID AC_BATCH_CREATIONUSERID
OperatorUserID AC_BATCH_OPERATORUSERID (userID of last batch history entry)
UserID AC_BATCH_USERID
UserName AC_BATCH_USERNAME
WindowsUserName AC_BATCH_WINDOWSUSERNAME
Add all info in a script locator for easy access
- pXDoc.Locators.ItemByName("MyScriptLocator").Alternatives(0).SubFields.ItemByName("AC_BatchDirectory").Text
- pXDoc.Locators.ItemByName("MyScriptLocator").Alternatives(0).SubFields(0).Text
Private Sub MyScriptLocator_LocateAlternatives(ByVal pXDoc As CASCADELib.CscXDocument, ByVal pLocator As CASCADELib.CscXDocField)
pLocator.Alternatives.Create
pLocator.Alternatives(0).Confidence = 1
pLocator.Alternatives(0).SubFields.Create("AC_BatchName")
pLocator.Alternatives(0).SubFields.Create("AC_BatchClassName")
pLocator.Alternatives(0).SubFields.Create("AC_BatchPriority")
pLocator.Alternatives(0).SubFields.Create("AC_BatchDirectory") 'Documentation uses the variable name: AC_BATCH_DIRECTORY and the software uses the name: AC_IMAGE_DIRECTORY
pLocator.Alternatives(0).SubFields.Create("AC_BatchExtarnalBatchID") 'Documentation uses the variable name: AC_BATCH_EXTERNAL_BATCHID and the software uses the name: AC_EXTERNAL_BATCHID
pLocator.Alternatives(0).SubFields.Create("AC_BatchGUID")
pLocator.Alternatives(0).SubFields.Create("AC_BatchCreationDateTime")
pLocator.Alternatives(0).SubFields.Create("AC_BatchCreationSiteName")
pLocator.Alternatives(0).SubFields.Create("AC_BatchCreationUserID")
pLocator.Alternatives(0).SubFields.Create("AC_BatchOperationUserID")
pLocator.Alternatives(0).SubFields.Create("AC_BatchUserID")
pLocator.Alternatives(0).SubFields.Create("AC_BatchUserName")
pLocator.Alternatives(0).SubFields.Create("AC_BatchWindowsUserName")
Dim pXRootFolder As CscXFolder
Set pXRootFolder = GetRootFolder(pXDoc.ParentFolder)
BatchInfo(pXRootFolder, "AC_BATCH_NAME", pLocator, "AC_BatchName")
BatchInfo(pXRootFolder, "AC_BATCH_CLASS_NAME", pLocator, "AC_BatchClassName")
BatchInfo(pXRootFolder, "AC_BATCH_PRIORITY", pLocator, "AC_BatchPriority")
BatchInfo(pXRootFolder, "AC_IMAGE_DIRECTORY", pLocator, "AC_BatchDirectory")
BatchInfo(pXRootFolder, "AC_EXTERNAL_BATCHID", pLocator, "AC_BatchExtarnalBatchID")
BatchInfo(pXRootFolder, "AC_BATCH_GUID", pLocator, "AC_BatchGUID")
BatchInfo(pXRootFolder, "AC_BATCH_CREATIONDATETIME", pLocator, "AC_BatchCreationDateTime")
BatchInfo(pXRootFolder, "AC_BATCH_CREATIONSITENAME", pLocator, "AC_BatchCreationSiteName")
BatchInfo(pXRootFolder, "AC_BATCH_CREATIONUSERID", pLocator, "AC_BatchCreationUserID")
BatchInfo(pXRootFolder, "AC_BATCH_OPERATORUSERID", pLocator, "AC_BatchOperationUserID")
BatchInfo(pXRootFolder, "AC_BATCH_USERID", pLocator, "AC_BatchUserID")
BatchInfo(pXRootFolder, "AC_BATCH_USERNAME", pLocator, "AC_BatchUserName")
BatchInfo(pXRootFolder, "AC_BATCH_WINDOWSUSERNAME", pLocator, "AC_BatchWindowsUserName")
End Sub
Private Function BatchInfo(ByVal RootFolder As CscXFolder, ByVal sBatchInfo As String, ByVal Locator As CscXDocField, ByVal sSubFieldName As String) As CscXDocSubField
Set BatchInfo = Locator.Alternatives(0).SubFields.ItemByName(sSubFieldName)
If RootFolder.XValues.ItemExists(sBatchInfo) = True Then
BatchInfo.Text = RootFolder.XValues.ItemByName(sBatchInfo).Value
BatchInfo.ExtractionConfident = True
BatchInfo.Confidence = 1
End If
End Function
Public Function GetRootFolder(pXFolder As CASCADELib.CscXFolder) As CASCADELib.CscXFolder
If pXFolder.IsRootFolder Then
Set GetRootFolder = pXFolder
Else
Set GetRootFolder = GetRootFolder(pXFolder.ParentFolder)
End If
End Function
Sum columns in table
Below code summarize column 5 in the table
pXDoc.Fields.ItemByName(”Table”).Table.GetColumnSum(4,True)
Add coordinates to a table cell
The only way to add coordinates to a table cell is to append a Word.
Dim Word As CscXDocWord
Set Word = New CscXDocWord
Word.PageIndex = pXDoc.Fields.ItemByName("POnr").PageIndex
Word.Left = pXDoc.Fields.ItemByName("POnr").Left
Word.Width = pXDoc.Fields.ItemByName("POnr").Width
Word.Top = pXDoc.Fields.ItemByName("POnr").Top
Word.Height = pXDoc.Fields.ItemByName("POnr").Height
Word.Text = pXDoc.Fields.ItemByName("POnr").Text
pXDoc.Fields.ItemByName("OrderRader").Table.Rows(0).Cells(2).AddWordData(Word)
Include/exclude result from locator with help of dictionary
You need one locator, one script locator and one dictionary
Goal is to check the locator result against a dictionary
Private Sub OrgNrSL_LocateAlternatives(ByVal pXDoc As CASCADELib.CscXDocument, ByVal pLocator As CASCADELib.CscXDocField)
Dim Alt As String 'Alt är texten i alternativet
Dim i As Integer 'i är antalet alternativ
If pXDoc.Locators.ItemByName("OrgNr").Alternatives.Count > 0 Then
For i = 0 To pXDoc.Locators.ItemByName("OrgNr").Alternatives.Count -1
Alt = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Text
If ExistOrgNr(Alt) = True Then 'if True EXKLUDE values from Dictionary, False INKLUDES values from Dictionary
' Gör ingenting
Else
Dim oAlt As CscXDocFieldAlternative
Set oAlt = pLocator.Alternatives.Create()
oAlt.Text = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Text
oAlt.Confidence = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Confidence
oAlt.Left = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Left
oAlt.Top = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Top
oAlt.Width = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Width
oAlt.Height = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).Height
oAlt.PageIndex = pXDoc.Locators.ItemByName("OrgNr").Alternatives(i).PageIndex
End If
Next i
End If
End Sub
Function ExistOrgNr(Alt) As Boolean
Dim DictResItems As CscDictionaryResItems
Dim Dict As CscDictionary
Dim strData As String
Dim strReplaceVal As String
Dim QueryText As String
ExistOrgNr=False
QueryText=Alt
Set Dict = Project.Dictionaries.ItemByName("OrgNrExclude")
Set DictResItems=Dict.Search(QueryText,CscEvalMatchQuery,5) ' Fuzzy search
'Set DictResItems=Dict.SearchExpanded(QueryText,CscEvalMatchQuery,5,10,1) 'Exact search
If DictResItems.Count>0 Then
'strData innehåller resultatet
'strReplaceVal innehåller det eventuella "replacement value" i dictionary
Dict.GetRecordData(DictResItems(0).RecID,strData,strReplaceVal)
ExistOrgNr=True 'Match hittades
Else
'Ingen match hittades
ExistOrgNr=False
End If
Replace characters using ASCI
Below is to remove line feed and carriage return
Dim FormatedText = Replace("string to be formated", Chr(10), "") 'Line Feed
Dim FormatedText = Replace("string to be formated", Chr(13), "") 'Carriage Return
Remove Unwanted Characters
Function RemoveUnwantedChar(strIn As String)
Dim i As Integer
Dim Char, Res, ReturnVal As String
Dim rgx As New RegExp
rgx.Pattern = "[A-Za-z\s]"
For i = 1 To Len(strIn)
Char = Mid(strIn,i,1)
Res = rgx.Replace(Char, "")
ReturnVal = ReturnVal + Res
Next i
RemoveUnwantedChar = ReturnVal
End Function
Check if ISIN code is valid
Function isValidISIN(ISIN)
Dim i, myInt As Integer
Dim myChar, ISINValue As String
For i = 1 To 12
myChar = UCase(Mid(ISIN, i, 1)) 'Get the character in Upper Case
If IsNumeric(myChar) Then
myInt = CInt(myChar)
Else
myInt = Asc(myChar) - 55 'If it's an alpha, convert to numeric
End If
ISINValue = ISINValue & myInt 'Rebuild a string with converted alphas
Next
Dim TotalOdd, TotalEven, Total As Integer
Dim TotaloddString, TotalEvenString, TotalString As String
If IsNumeric(ISINValue) Then
Total = 0
'get odd numbers starting with the second to last digit (ignoring the check digit)
For i = Len(ISINValue)-1 To 1 Step -2
TotalOdd = CInt(Mid(ISINValue, i, 1) * 2)
TotaloddString = TotaloddString & CStr(TotalOdd)
Next i
TotalOdd = 0
For i = 1 To Len(TotaloddString)
TotalOdd = TotalOdd + CInt(Mid(TotaloddString, i, 1))
Next i
'get even numbers starting with the third to last digit (ignoring the check digit)
For i = Len(ISINValue)-2 To 1 Step -2
TotalEvenString = TotalEvenString & (Mid(ISINValue, i, 1))
Next i
For i = 1 To Len(TotalEvenString)
TotalEven = TotalEven + CInt(Mid(TotalEvenString, i, 1))
Next i
Total = TotalOdd + TotalEven
TotalString =CStr(Total)
TotalString=Right(TotalString,1)
Total=10-CInt(TotalString)
If Right(ISINValue, 1) = Right(CStr(Total),1) Then
isValidISIN = True
Else
isValidISIN = False
End If
Else
isValidISIN = False
End If
End Function
Create Results for a Script Locator
pLocator.Alternatives.Create
pLocator.Alternatives(<N>).Text = <text>
pLocator.Alternatives(<N>).Confidence = <Confidence Value>
pLocator.Alternatives(<N>).Top = <Top Coordinate>
pLocator.Alternatives(<N>).Left = <Left Coordinate>
pLocator.Alternatives(<N>).Height = <Height>
pLocator.Alternatives(<N>).Width = <Width>
Route and create new child batch to Validation2 or other
Add below code to project script, below is triggered in validation.
Private Sub Batch_Close(ByVal pXRootFolder As CASCADELib.CscXFolder, ByVal CloseMode As CASCADELib.CscBatchCloseMode)
If CloseMode = CscBatchCloseFinal And Project.ScriptExecutionMode=CscScriptModeValidation Then
RouteDoc2(pXRootFolder)
End If
End Sub
Private Function RouteDoc2(ByRef pXRootFolder As CASCADELib.CscXFolder)
Dim i As Integer
Dim xDocInfo As CscXDocLib.CscXDocInfo
For i = 0 To pXRootFolder.GetTotalDocumentCount - 1
Set xDocInfo = pXRootFolder.GetDocInfoByGlobalIndex(i)
If xDocInfo.XDocument.Fields.ItemByName("NeedCheck").Text = "Efterkontroll" Then
'First check if batch exists
If pXRootFolder.XValues.ItemExists("KTM_DOCUMENTROUTING_BATCHNAME_" & "NG") = False Then
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_BATCHNAME_" & "NG", pXRootFolder.XValues("AC_BATCH_NAME") & "_Efterkontroll")
End If
xDocInfo.XDocument.Fields.ItemByName("NeedCheck").Valid = False
xDocInfo.XValues.Set("KTM_DOCUMENTROUTING", "NG")
Else
'First check if batch exists
If pXRootFolder.XValues.ItemExists("KTM_DOCUMENTROUTING_BATCHNAME_" & "OK") = False Then
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_BATCHNAME_" & "OK", pXRootFolder.XValues("AC_BATCH_NAME") & "_Godkänd")
End If
xDocInfo.XValues.Set("KTM_DOCUMENTROUTING", "OK")
End If
Next
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_QUEUE_OK", "KC.Export")
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_QUEUE_NG", "KTM.Validation2")
'KC.Export
'KC.QC
'KC.PDF
'KC.Verification
'KTM.Correction
'KTM.Validation
'KTM.Validation<N>
'KTM.KBLearningServer
'KTM.Verification
End Function
Change batch name in validation
Add a button in validation form and add below script in the validationForm_ButtonClicked event
Case "Button0"
'Rename batch with button click
Dim pXRootFolder As CASCADELib.CscXFolder
Set pXRootFolder = pXDoc.ParentFolder
Dim xDocInfo As CscXDocLib.CscXDocInfo
Set xDocInfo = pXRootFolder.GetDocInfoByGlobalIndex(0)
Dim BatchNameField As String
BatchNameField = pXDoc.Fields.ItemByName("RenameBatch").Text
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_BATCHNAME_" & BatchNameField, BatchNameField)
xDocInfo.XValues.Set("KTM_DOCUMENTROUTING", BatchNameField)
Add a function for the renaming
Private Function SetBatchNameSuspend(ByRef pXRootFolder As CASCADELib.CscXFolder)
Dim BatchName As String
Dim xDocInfo As CscXDocLib.CscXDocInfo
Dim i As Integer
For i = 0 To pXRootFolder.GetTotalDocumentCount - 1
Set xDocInfo = pXRootFolder.GetDocInfoByGlobalIndex(i)
BatchName = xDocInfo.XDocument.Fields.ItemByName("RenameBatch").Text
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_BATCHNAME_" & "allokay", BatchName & "_" & Format(Now,"yyyy-MM-dd_HH:mm:ss"))
xDocInfo.XValues.Set("KTM_DOCUMENTROUTING", "allokay")
Next
End Function
Add below code in the Batch_Close event
Private Sub Batch_Close(ByVal pXRootFolder As CASCADELib.CscXFolder, ByVal CloseMode As CASCADELib.CscBatchCloseMode)
If CloseMode = CscBatchCloseSuspend Then
Dim i As Long
For i = 0 To pXRootFolder.GetTotalDocumentCount - 1
Dim oXDocInfo As CASCADELib.CscXDocInfo
Set oXDocInfo = pXRootFolder.GetDocInfoByGlobalIndex(i)
oXDocInfo.XValues.Set("KTM_DOCUMENTROUTING", "allokay")
Next
SetBatchNameSuspend(pXRootFolder)
pXRootFolder.XValues.Set("KTM_DOCUMENTROUTING_QUEUE_allokay", "KTM.Validation")
End If
End Sub
Print page from validation form
NOTE: only works for rich client
This will open your default image viewer with the selected image, from there you can print the page.
Private Sub ValidationForm_ButtonClicked(ByVal ButtonName As String, ByVal pXDoc As CASCADELib.CscXDocument)
Select Case ButtonName
Case "ButtonPrint"
Dim Image As CscImage
Dim PageIndex As Integer
PageIndex = ValidationForm.CurrentPageIndex
Set Image = pXDoc.CDoc.Pages(PageIndex).GetImage
Shell "explorer.exe " & Image.FileName, vbNormalFocus
End Select
End Sub