The Search for a Great Tiff iFilter

I recently wrote a VBScript utility that queries the contents of an Indexing Service database, finds the indexed Fax documents (CCITT Group 4 (2d) Tiff's), sorts and moves them to another repository located on a SAN.

Option Explicit
Dim oCon
Dim oCmd
Dim oRst
Dim sQry
Dim sString
Dim sScope
Dim sAqScan
Dim sFile
Dim sPath
Dim sMoveTo
Dim sNum
Dim FSO
Dim sDate
Dim sDosText
Dim sDateDir
Dim sDateDiff
Dim sMonth
Dim sDay
Dim sYear
Dim nCnt


'///////////////////////////////////////////
'
' Create the FSO
'
'////////////////////////////////////////////////

Set FSO = CreateObject("Scripting.FileSystemObject")


'/////////////////////////////////////////////////
'
'   Scope, Aquaius scan dir and Query.
'
'////////////////////////////////////////////////

sScope = "F:\Incoming Fax\CWHHM\"
sAqScan = "F:\Scanned Docs\Aquarius\14CWHHM\"
sQry = "Select Path, Filename, Size, Contents " _
  & "FROM Scope('DEEP TRAVERSAL OF " & chr(34) & sScope & chr(34) & "') "


'/////////////////////////////////////////////////
'
'   Meridian Search and move.
'
'////////////////////////////////////////////////

sString = "Meridian"
sMoveTo = sScope & "Meridian\"
Call ConnectDb
Call MoveIn


'/////////////////////////////////////////////////
'
'   Boise Search and move.
'
'////////////////////////////////////////////////

sString = "Boise"
sMoveTo = sScope & "Boise\"
Call ConnectDb
'Call MoveIn


'//////////////////////
' We will assume the rest
' are Boise documents

Dim sFolder
Dim sFileColl

' ///////////////////////////////////////////
' Set the folder and file collection
Set sFolder = FSO.GetFolder(sScope)
Set sFileColl = sFolder.Files

' //////////////////////////////////////////
' Loop over the direcory of remaining files
' and move them into the moveto dir
For Each sFile in sFileColl
    ' This is needed to avoid trying
    ' to move Thumb.db files where
    ' some usually exist at the destination.
    ' the movefile method will fail in that case.
    On Error Resume Next
    FSO.MoveFile sFile, sMoveTo
    sNum = sNum + 1
Next

Set sFolder = Nothing
Set sFileColl = Nothing


' //////////////////////////////////////////////
'
' Now wait a number of minutes so we can
' query on the DOS
'
' //////////////////////////////////////////////

If sNum < 50 Then
        'WScript.Echo "Sleeping for 5  minutes"
        WScript.Sleep 300000
ElseIf sNum < 150 Then
        'WScript.Echo "Sleeping for 10  minutes"
        WScript.Sleep 600000
ElseIf sNum < 250 Then
        'WScript.Echo "Sleeping for 20  minutes"
        WScript.Sleep 1200000
End If

'------------------------------/////////////// END


'/////////////////////////////////////////////////
'
'   Meridian Date Search and move.
'
'////////////////////////////////////////////////

sScope = "F:\Incoming Fax\CWHHM\Meridian\"
sQry = "Select Path, Filename, Size, Contents " _
  & "FROM Scope('DEEP TRAVERSAL OF " & chr(34) & sScope & chr(34) & "') "
  
  
sDosText = "Date of Service: "
sDate = Pd(Month(Date()),2) & "/" & Pd(Day(Date()),2) & "/" & Year(Date())
sDateDir = Pd(Month(Date()),2) & Pd(Day(Date()),2) & Year(Date())

For nCnt = 1 to 25

' First set the move to location
sMoveTo = sAqScan & "MDN\" & sDateDir & "\"

' Now set the search string
sString = sDosText & sDate

' Now look for the DOS
Call ConnectDb

' And now move them
MoveOver(sMoveTo)

' Reduce the date by one day
sDate = DateAdd("d", -1, sDate)

'Re-pad the date
sDateDiff = Split(sDate, "/")
sMonth = sDateDiff(0)
sDay = sDateDiff(1)
sYear = sDateDiff(2)

sDate = Pd(sDateDiff(0),2) & "/" & Pd(sDateDiff(1),2) & "/" & sDateDiff(2)
sDateDir = Pd(sDateDiff(0),2) & Pd(sDateDiff(1),2) & sDateDiff(2)

Next


'If there are any left, move them into an UNKDOS folder
sMoveTo = sAqScan & "MDN\UNKDOS\"

If Not FSO.FolderExists(sMoveTo) Then
    FSO.CreateFolder(sMoveTo)
End If

' ///////////////////////////////////////////
' Set the folder and file collection
Set sFolder = FSO.GetFolder(sScope)
Set sFileColl = sFolder.Files

' //////////////////////////////////////////
' Loop over the direcory of remaining files
' and move them into the moveto dir
For Each sFile in sFileColl
    FSO.MoveFile sFile, sMoveTo
Next

'------------------------------/////////////// END


'/////////////////////////////////////////////////
'
'   Boise Date Search and move.
'
'////////////////////////////////////////////////

sScope = "F:\Incoming Fax\CWHHM\Boise\"
sQry = "Select Path, Filename, Size, Contents " _
  & "FROM Scope('DEEP TRAVERSAL OF " & chr(34) & sScope & chr(34) & "') "
  
sDosText = "Date of Service: "
sDate = Pd(Month(Date()),2) & "/" & Pd(Day(Date()),2) & "/" & Year(Date())
sDateDir = Pd(Month(Date()),2) & Pd(Day(Date()),2) & Year(Date())

For nCnt = 1 to 25

' First set the move to location
sMoveTo = sAqScan & "BSE\" & sDateDir & "\"

' Now set the search string
sString = sDosText & sDate

' Now look for the DOS
Call ConnectDb

' And now move them
MoveOver(sMoveTo)

' Reduce the date by one day
sDate = DateAdd("d", -1, sDate)

'Re-pad the date
sDateDiff = Split(sDate, "/")
sMonth = sDateDiff(0)
sDay = sDateDiff(1)
sYear = sDateDiff(2)

sDate = Pd(sDateDiff(0),2) & "/" & Pd(sDateDiff(1),2) & "/" & sDateDiff(2)
sDateDir = Pd(sDateDiff(0),2) & Pd(sDateDiff(1),2) & sDateDiff(2)

Next

'If there are any left, move them into an UNKDOS folder
sMoveTo = sAqScan & "BSE\UNKDOS\"

If Not FSO.FolderExists(sMoveTo) Then
    FSO.CreateFolder(sMoveTo)
End If

' ///////////////////////////////////////////
' Set the folder and file collection
Set sFolder = FSO.GetFolder(sScope)
Set sFileColl = sFolder.Files

' //////////////////////////////////////////
' Loop over the direcory of remaining files
' and move them into the moveto dir
For Each sFile in sFileColl
    FSO.MoveFile sFile, sMoveTo
Next

'------------------------------/////////////// END




'/////////////////////////////////////////////////
'
'   First Move Sub
'
'////////////////////////////////////////////////

Sub MoveIn()

' Loop over the query until it is empty
Do While Not oRst.EOF
    sFile = oRst("Path")
    FSO.MoveFile sFile, sMoveTo
    oRst.MoveNext
    sNum = sNum + 1
Loop


End Sub

'------------------------------/////////////// END


'/////////////////////////////////////////////////
'
'   Big Move Sub
'
'////////////////////////////////////////////////

Function MoveOver(sMoveTo)

Do While Not oRst.EOF
    sFile = oRst("Path")
          If FSO.FolderExists(sMoveTo) Then
              'MsgBox "Moving file " & sFile & " to " & sMoveTo & "."
              FSO.MoveFile sFile, sMoveTo
          Else
              FSO.CreateFolder(sMoveTo)
              'MsgBox "Folder " & sMoveTo & " created."
              FSO.MoveFile sFile, sMoveTo
              'MsgBox "File " & sFile & " moved to " & sMoveTo & "."
          End If
        oRst.MoveNext
Loop

End Function

'------------------------------/////////////// END






'/////////////////////////////////////////////////
'
'   Date Formatting function
'
'////////////////////////////////////////////////

Function pd(n, totalDigits) 
   If totalDigits > len(n) Then
       pd = String(totalDigits-len(n),"0") & n 
   Else 
       pd = n 
   End If 
End Function

'------------------------------/////////////// END

'/////////////////////////////////////////////////
'
'   Connection Sub
'
'////////////////////////////////////////////////

Sub ConnectDB()
Set oCon = CreateObject("ADODB.Connection")
Set oRst = CreateObject("ADODB.RecordSet")
Set oCmd = CreateObject("ADODB.Command")

With oCon
    .ConnectionString = "Provider=msidxs; Data Source = IncomingFax"
    .Open
End With

If oCon.State = 0 Then
    MsgBox "Connection failed."
WScript.Exit
End If

With oCmd
    .ActiveConnection = oCon
    .CommandText = sQry & "Where Contains('" & chr(34) & sString & chr(34) & "')"
    .CommandType = 1
End With

With oRst
    .CursorType = 3
    .CursorLocation = 3
    .LockType = 3
    .Open oCmd
End With

End Sub

'------------------------------/////////////// END

Their they sit to later be inserted into a document management program called Aquarius DMS.

I initially installed and was using the MODI (Microsoft Office Document Imaging) package on my file server to utilize the Tiff iFilter it included, but found that it wasn't finding everything I needed it to, so decided to try another iFilter made by Captaris. I was hoping to get better results in their OCR abilities over MODI's.

Unfortunately, the Captaris product didn't improve my results, so I switched back to MODI. No need to spend $300! Yay!