Solved

Information..

Posted on 2000-04-19
8
267 Views
Last Modified: 2010-05-02
Do anyone of you know about Document Imaging tools and Particularly about FileMat? One of a client has this requirement and I was told it is related to Visual Basic? Any information about this is appreciated.
0
Comment
Question by:ravink
  • 4
  • 4
8 Comments
 
LVL 12

Expert Comment

by:mark2150
ID: 2730811
Done some document imaging with Adobe. Not heard about FileMat.

M
0
 

Author Comment

by:ravink
ID: 2730841
Can it be FileNet, Document Imaging tools related
0
 
LVL 12

Expert Comment

by:mark2150
ID: 2730967
Dunno.

Wrote document scan/retreival system in VB based on hp scanner and Adobe. Scanner had "copier" software that would scan and immediately print. I just set the default printer as Adobe "device" and scan process immediately started creating .PDF files.

Had clerical type place "postit" note on each page with client ID's. When manual annotation was complete ran small piece of custom VB to search for files, combine pages from related files into master document and then search all documents for notes. Info as to document ID, page and reference numbers all placed in LAN based .MDB file. Users have lookup module (again in VB) that queries database and gets list of canidate documents. The click on document from list and Adobe displays/prints selected page from 1/4 million on file.

M
0
 

Author Comment

by:ravink
ID: 2731000
Thanks, Sounding great. Is it possible for you to send the code for the project you explained here. Very curiuos to look at it.
Appreciate it.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 12

Expert Comment

by:mark2150
ID: 2731087
Well it's not very elegant. It drives adobe Acrobat with SENDKEYs. It does work well however. We also added some data management touches like organizing the data into CD-ROM sized piles so that we could spool off old data to CD. We have a master BOT (Beginning Of Time) database that contains the volume ID's of all records. This allows the system to retreive pointers to documents that are no longer online. When a use wants to retreive a document if it's in the past four months it's pulled up from the online data and if it's older than that the user is prompted for the apprpriate CD to be mounted.

I can give some code snips, but if you want the full app we'll have to talk money.

M
0
 

Author Comment

by:ravink
ID: 2731122
Get me some code snips if possible.
What ever that helps me to play with documents...
Thanks
0
 
LVL 12

Accepted Solution

by:
mark2150 earned 100 total points
ID: 2731475
Here is main portion of document retreival module...


'
' Program to rapidly lookup specific pages in Acrobat files
' By: Mark M. Lambert on November 23, 1998
' This is a 'work for hire' for Sterling & King
' Copyright 1998 - Sterling & King - All Rights Reserved
'
' V1.6.x - 15 Dec 98 - MML - Production Version
' V1.5.x - 12 Dec 98 - MML - Lint pass
' V1.4.x - 10 Dec 98 - MML - Add registry functions
' V1.3.x -  9 Dec 98 - MML - Continue
' V1.2.x -  7 Dec 98 - MML - Make work with real file
' V1.1.x - 24 Nov 98 - MML - Make run with .MDB
' V1.0.x - 23 Nov 98 - MML - Initial Code
'
Public RetVal     As Double     'Process ID
Public RefPath    As String     'Path to DOCS.MDB
Public RefDoc     As String     'DOCS.MDB constant
Public serverUNC  As String     'Jaz Server reference constant
Public Quote      As String     ' " character
Public Adobe_Path As String     'Path to Adobe Reader
'
Dim Vols(4)       As String     'Active volumes
Dim Drives(4)     As String     'Drive letters
Dim Flags(4)      As Boolean    'State flags if drives are active
Dim db(4)         As Database   'Database linkage
Dim rs(4)         As Recordset  'Recordset linkage
'
' These data type declarations are required to support the obscure windows
' function to spawn a child task and wait for it to finish before continuing
'
Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
'
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type
'
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long
'
Private Declare Function CreateProcessA Lib "kernel32" ( _
    ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As String, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long
'
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'
Const NORMAL_PRIORITY_CLASS = &H20&
Const INFINITE = -1&
'
' ---------------------------------------------------------
' I don't really understand the above declares, but they do work so DON'T MESS WITH THEM!
'

Public Sub ExecCmd(cmdline$)
'
' This executes an external windows program and waits for it to complete
'
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
'
' Initialize the STARTUPINFO structure:
'
start.cb = Len(start)
'
' Start the shelled application
'
Call log("External process: " & cmdline$ & " started", "", vbBlack)
'
ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
'
' Wait for the shelled application to finish:
'
holdhere:
    DoEvents
    ret& = WaitForSingleObject(proc.hProcess, 5000)
    If ret& <> 0 Then GoTo holdhere
'
ret& = CloseHandle(proc.hProcess)
End Sub
'
Private Sub btn_exit_Click()
    Call die
End Sub

Private Sub Btn_Find_Click()
'
' ***** FIX THIS! *****
'
' This module is searching the .MDB files on each of the
' available volumes to find the references. Actually what
' we should search is the BOT file so we can find everyting
' that has ever been scanned. However, right now, the BOT
' master hasn't been created yet making it quite difficult to
' search.
'
' When EXTRACT runs it should open the BOT file and search
' for all records with the current VOLUMEID. Then those
' records should be deleted and *THEN* the newly extracted
' data can be appended. Finally we need to compact the data
' base to keep that puppy from growing like topsy.
'
' For now we'll look up each of the four .MDB's individually
'
' *********************
'
' Get all four sets of data
'
List1.Clear     'Blow list clear
For ndx = 0 To 3
    If Flags(ndx) Then
        If Len(debtor.Text & client.Text) < 1 Then GoTo skipthis
        '
        SortKey = "select * from results where client like '" & client.Text & "*' or debtor=" & debtor.Text
        If Len(debtor.Text) < 1 Then SortKey = "select * from results where client like '" & client.Text & "*'"
        If Len(client.Text) < 1 Then SortKey = "select * from results where debtor=" & debtor.Text
 '
        Call log("Searching: " & SortKey, "", vbBlue)
        Set rs(ndx) = db(ndx).OpenRecordset(SortKey)
        If rs(ndx).BOF And rs(ndx).EOF Then GoTo isempty
        '
        rs(ndx).MoveFirst
        Do While Not rs(ndx).EOF
            file = rs(ndx)!filename
            marker = InStr(file, ".")
            If marker > 0 Then file = Left(file, marker - 1)
            temp = rs(ndx)!client & vbTab & rs(ndx)!debtor & vbTab & rs(ndx)!diskvol & ":" & file & "." & rs(ndx)!pagenum
            '
            List1.AddItem temp
            List1.ItemData(List1.NewIndex) = ndx
            rs(ndx).MoveNext
        Loop
'
isempty:
        rs(ndx).Close
        '
skipthis:
    End If
Next ndx
'
Call log("Found:" & Str(List1.ListCount - 1) & " matches", "", vbBlue)
'
' Only turn on print & show buttons if there's something in the list
' to select from
'
If List1.ListCount < 1 Then
    btn_print.Enabled = False
    msg = client.Text
    If Len(msg) > 0 And Len(debtor.Text) > 0 Then msg = msg & "/"
    msg = msg & debtor.Text
    old = Wait.Caption
    Wait.Hide
    Wait.Caption = "NOT FOUND!"
    Wait.Label1.Caption = "No match on search for:" & vbCrLf & msg
    Wait.Show
    Wait.Refresh
    Call delay(3)
    Wait.Hide
    Wait.Caption = old
Else
    btn_print.Enabled = True
End If
'
' I wonder if they would like me to maintain a log...
'
End Sub

Private Sub btn_print_Click()
Call showpage("print")
'
End Sub

Private Sub client_Change()
Call testfind
'
End Sub

Private Sub Config_Click()
Me.Hide
configure.Show
End Sub

Private Sub debtor_Change()
Call testfind
'
End Sub

Private Sub Form_DblClick()
Copyright.Show
'
End Sub

Private Sub Form_Load()
Dim anyflag As Boolean
'
Quote = Chr(34)         'Double quote symbol constant
Me.Caption = "Document Finder - V" & Trim(Str(App.Major)) & "." & Trim(Str(App.Minor)) & "." & Trim(Str(App.Revision))
'
' Init constants
'
List1.Clear
'
' This needs to come from the registry
'
serverUNC = "\\imageserve"
RefPath = "\clients"
RefDoc = "docs.mdb"
'
Load configure
Load runlog1
'
Call log(App.EXEName & " started", "B", vbRed)
'
Call getreg         'Pull in other settings from registry
'
Call Init           'Find out where the Adobe is located
'
' We also need to look in the DISKVOL file and read the first line to derive
' the volume label
'
anyflag = False             'Watch for anything being available
On Error Resume Next        'Ignore "not found" errors
'
' We're reserving the 0th item for the BOT database
'
For ndx = 0 To 3
    X = 0
    X = FileLen(Drives(ndx) & "\" & RefDoc)
    If X < 1000 Then
        Flags(ndx) = False
    Else
        Flags(ndx) = True
        anyflag = True
        Set db(ndx) = DBEngine.Workspaces(0).OpenDatabase(Drives(ndx) & "\" & RefDoc)
    End If
    '
Next ndx
'
' If Not anyflag Then Call die        'Quick death on no data files
'
' Ok, we need to search for acrobat reader and get a pointer
' to it. I think we should simply spawn a copy of it right
' off the bat full sized, but without focus.
'
' This needs to be from the Registry and look for the READER and not EXCHANGE!
'
RetVal = Shell(Quote & Adobe_Path & Quote, vbMaximizedFocus)
Call delay(3)
Me.Show
'
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call die
End Sub
Private Sub die()
Dim frm As Form
'
runlog1.Timer1.Enabled = False
'
' "pro forma"
'
On Error Resume Next
Close
'
AppActivate RetVal
SendKeys "%FX", True       'Close child window if its open
DoEvents
'
' Button up log
'
Call log("Program shutdown", "B", vbRed)
runlog1.logbox.SaveFile App.Path & "\" & App.EXEName & ".RTF", rtfRTF
'
    For Each frm In Forms
        Unload frm
        Set frm = Nothing
    Next frm
'
' Terminus
'
End
' =====================================
' =====================================
'
' Fin
'
' =====================================
' =====================================
End Sub
Private Sub sendit(txt As String)
'
' Send string to child task
'
On Error Resume Next    'Ignore any errors that occur
AppActivate RetVal      'Make sure child task is active
DoEvents                'Give it a shot to run
SendKeys txt, True      'Tell it what to do and wait
DoEvents                'Cede some more time
'
End Sub

Private Sub delay(secs As Integer)
'
' Sanity check passed param
'
secs = Abs(secs)
If secs > 100 Then secs = 100
'
' Pass delay value and diddle here until time expires
'
etime = Timer + secs
    Do While Timer < etime
        DoEvents
    Loop
'
End Sub

Private Sub testfind()
'
' Turn on find button if either client or debtor are non-blank
'
If (Len(client.Text) > 0) Or (Len(debtor.Text) > 0) Then
    Btn_Find.Enabled = True
Else
    Btn_Find.Enabled = False
End If
'
End Sub

Private Sub List1_DblClick()
Call showpage("")
End Sub
Private Sub showpage(param As String)
'
' If PARAM = PRINT then go to page and issue *PRINT* command
'
' Having found a choice, we now need to convert that choice into a
' file specification
'
' ***************************************************
' ****** THIS IS LINKED TO LIST DISPLAY FORMAT ******
' ***************************************************
'
thisitem = List1.List(List1.ListIndex)
'
marker1 = 0
marker2 = 0
marker1 = InStr(thisitem, vbTab)
If marker1 < 1 Then GoTo drain
'
marker2 = InStr(marker1 + 1, thisitem, vbTab)
If marker2 < 1 Then GoTo drain
'
thisitem = Trim(Right(thisitem, Len(thisitem) - marker2))
'
' Ok, we've got tail in:
'
' DISKVOL:FILE.PAGE format
'
marker1 = 0
marker2 = 0
marker1 = InStr(thisitem, ":")
If marker1 < 1 Then GoTo drain
'
marker2 = InStr(thisitem, ".")
If marker2 < marker1 Then GoTo drain
'
volume = Left(thisitem, marker1 - 1)
filename = Mid(thisitem, marker1 + 1, marker2 - (marker1 + 1))
onpage = Right(thisitem, Len(thisitem) - marker2)
'
' Sanity check extracted values
'
If Len(volume) < 1 Or Len(filename) < 1 Or Len(onpage) < 1 Then GoTo drain
'
If InStr(filename, ".") < 1 Then filename = filename & ".PDF"
'
' Ok, we've now got three vars:
'
' VOLUME - Contains volume ID of disk containing the datum
' FILENAME - File name with .PDF extension
' ONPAGE - page number within document
'
' We need a little more complexity here. The file name is easy enough to
' determine, but we should validate the DISKVOL file to make sure we're
' on the right volume. Anything that is not on one of the ONLINE volumes
' is, be definition, on a CD-ROM somewhere. Ask operator for CD and give
' option of cancelling. CD-ROM drive will generally be D: unless we know
' specifically otherwise. This also needs to be from the registry.
'
' We need to expand the logic here a bit to verify what
' drive has the volume ID. If we don't find it then we
' assume that the info is on CD and prompt the operator in insert
' the correct ID. Also we need to have RefPath in here to
' tell us which directory the data is in.
'
For ndx = 0 To 3
    If Vols(ndx) = volume Then
        '
        ' Found volume online. Point to that drive and skip
        ' rest
        '
        datadrive = Drives(ndx)
        GoTo showdoc
        ' ==========
    End If
    '
    ' Not this drive, try next
    '
Next ndx
'
' If we get here then the files are on CD-ROM
'
reply = MsgBox("Requested document file not online!" & vbCrLf & "Please insert the CD-ROM containing:" & vbCrLf & volume & " and click [Ok] to continue" & vbCrLf & "or click [Cancel] to access another document.", vbExclamation + vbOKCancel, "Document not ONLINE!")
If reply = vbCancel Then GoTo drain
'
' User has requested document on CD-ROM
'
datadrive = "D:"
'
showdoc:
'
' Ummm, one final check to derive wether document file actually
' exists. If not tell operator and log event
'
On Error GoTo nopdf
X = 0
X = FileLen(datadrive & "\" & filename)
'
' If we get here then the file exists, good - keep flying
'
On Error GoTo 0
'
Wait.Label1.Caption = "Please wait," & vbCrLf & "Accessing page #" & onpage & vbCrLf & "of document file: " & filename
Wait.Show
Wait.Refresh
'
Call log("Accessing Document: " & filename & " Page " & onpage, "I", vbBlue)
'
sendit ("%WA")                      'Close all windows
sendit ("%FO" & datadrive & "\" & filename & "{enter}")
sendit ("%VG")                      ' Issue page select command
sendit (onpage & "{enter}")         ' Specify page
'
' Ok, right here we need to make a decision about printing
'
If UCase(Trim(param)) = "PRINT" Then
    '
    ' Issue Print command
    '
    sendit ("%FP")
    '
    ' Just the one page
    '
    sendit ("%U{enter}")
End If
'
Wait.Hide
'
On Error Resume Next
AppActivate RetVal      'Flip adobe onto screen
DoEvents
'
GoTo drain              'Drop into exit point
' =================
'
' Here if after all of that we can't locate the file
'
nopdf:
Resume nopdf1
'
nopdf1:
'
Call log("Document: " & datadrive & "\" & filename & " unavailable!", "B", vbRed)
'
reply = MsgBox("ERROR!" & vbCrLf & "Document file: " & datadrive & "\" & filename & vbCrLf & "is NOT FOUND!", vbSystemModal + vbCritical + vbOKOnly, "Document Unavailable!")
'
drain:
End Sub
Public Sub log(msg As String, mode As String, color As Variant)
mode = UCase(Trim(mode))
With runlog1
..logbox.SelUnderline = InStr(mode, "U")
..logbox.SelBold = InStr(mode, "B")
..logbox.SelItalic = InStr(mode, "I")
..logbox.SelColor = color
'
..logbox.SelText = Now & " - " & msg & vbCrLf
End With
End Sub
Public Sub getreg()
Dim temp As String
Dim cmd As String
'
With configure
'.Text1(0).Text = GetSetting(App.CompanyName & "-" & App.EXEName, "Main", "Drive1")
'.Text1(1).Text = GetSetting(App.CompanyName & "-" & App.EXEName, "Main", "Drive2")
'.Text1(2).Text = GetSetting(App.CompanyName & "-" & App.EXEName, "Main", "Drive3")
'.Text1(3).Text = GetSetting(App.CompanyName & "-" & App.EXEName, "Main", "Drive4")
..Text1(4).Text = GetSetting(App.CompanyName & "-" & App.EXEName, "Main", "BOTIndexDir")
..Text1(5).Text = GetSetting(App.CompanyName & "-" & App.EXEName, "Main", "Adobe_path")
'
' Ok, validate and set to defaults if not set
'
'If Len(.Text1(0).Text) < 1 Then .Text1(0).Text = "K:"
'If Len(.Text1(1).Text) < 1 Then .Text1(1).Text = "L:"
'If Len(.Text1(2).Text) < 1 Then .Text1(2).Text = "M:"
'If Len(.Text1(3).Text) < 1 Then .Text1(3).Text = "N:"
If Len(.Text1(4).Text) < 1 Then .Text1(4).Text = "I:\MASTER"
'
Adobe_Path = .Text1(5).Text
'
'For ndx = 0 To 3
'    Drives(ndx) = .Text1(ndx)
'    Vols(ndx) = ""      'Clear volume labels
    '
    ' This is kind of a kludge, but there doesn't seem to be a simple
    ' way to get the volume label from the JAZ drive. I'm defining a root level
    ' file called DISKVOL that contains the volume label in YYMM format
    '
    ' Later note: I spoke with Dave re: the JAZ volume labels
    ' and he felt this approach was correct even tho cumbersome
    '
    temp = ""
'     On Error GoTo novol
    '
    ' *****
    ' RIGHT HERE we meed to modify this logic to support UNC naming
    ' If I go to DOS and do a:
    '
    ' DIR \\imageserve\jaz /ad /b /-p /on
    '
    ' It'll return:
    '
    ' 9810
    ' 9811
    ' 9901
    ' DISK3
    '
    ' Now instead of burning drive letters from the MAP function, I think I can
    ' reference the files by requesting:
    '
    ' \\imageserve\9810\clients\docs.mdb
    '
    ' Now this *SHOULD* work. If it does, it means that when we have the monthly
    ' cartridge change, none of the users will have to dork with changing their
    ' drive mappings as we can just do the DIR command shown above and then
    ' figure it out on our own. This will also eliminate having to keep the settings
    ' in the registry as we want fresh data no matter what.
    '
    ' The only problem I have right now is that this is 1.6.2 and the production system
    ' is at 1.7.1 so I'm a bug fix away from "gold" code.
    '
    ' This change will also eliminate the cumbersome patch of having the DISKVOL
    ' file on the drive and the kludge of having to init the damn thing every time
    ' we change the cart.
    '
    ' Now I did a check and a DOS DIR command to the UNC volume will work as long
    ' as the network sees that volume even if there are NO drive letters assigned...
    '
    ' Just did check of Adobe and it'll open a file with a UNC reference
    '
    ' \\imageserve\9810\clients\1084.pdf
    '
    ' Works like a charm!
    '
    ' We should put \\imageserve\jaz as a registry value for initialization
    '
    serverUNC = "\\imageserve"
    target = "C:\X"     'We'll always have a root of C: that we can access!
    cmd = Environ("comspec") & " /C dir " & serverUNC & "\jaz /ad /b /on /-p > " & target
    '
    Call log("Searching for: " & cmd, "B", vbRed)
    '
    ExecCmd (cmd)       'Scan disk for info
    '
    ' Ok, get result
    '
    On Error Resume Next
    fileid = FreeFile
    '
    Call log("Opening: " & target, "B", vbRed)
    '
    Open target For Input As fileid
        For ndx = 0 To 3
        Line Input #fileid, rawtext
        Vols(ndx) = Trim(rawtext)
        Drives(ndx) = serverUNC & "\" & Vols(ndx) & RefPath
        configure.Text1(ndx).Text = Drives(ndx)
        '
        Call log("Found: " & Drives(ndx), "B", vbRed)
        '
        '
        ' Ummm at this point Drives() should look like:
        '
        ' \\imageserve\9810\clients
        '
        ' Check for MDB file existance
        '
        result = Dir(Drives(ndx) & "\" & RefDoc)
        If Len(result) > 0 Then
            configure.Text1(ndx).BackColor = vbGreen
        Else
            configure.Text1(ndx).BackColor = vbRed
        End If
        '
        Next ndx
        '
    Close fileid
    '
'    Open Left(Drives(ndx), 2) & "\diskvol" For Input As #1
'        Line Input #1, temp
'        Vols(ndx) = Trim(temp)
'        configure.Text1(ndx).BackColor = vbGreen
'    GoTo volok
    ' =================
    '
    ' We get here if there is no volume label file on the drive
    ' Change the color of the status panel to red
'novol:
'    configure.Text1(ndx).BackColor = vbRed
'    Resume volok
    '
'volok:
'    Close
'    On Error GoTo 0
    '
'Next ndx
'
Call log("Registry read", "", vbBlack)
'
End With
GoTo drain
' ==============
puke:
Resume puke1
'
puke1:
'
On Error GoTo 0
Call log("Error reading: " & target, "B", vbRed)
'
drain:
End Sub
Public Sub putreg()
'
' Save to registry
'
With configure
SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "Drive1", .Text1(0).Text
SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "Drive2", .Text1(1).Text
SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "Drive3", .Text1(2).Text
SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "Drive4", .Text1(3).Text
SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "BOTIndexDir", .Text1(4).Text
SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "Adobe_path", .Text1(5).Text
End With
'
Call log("Registry settings saved", "", vbBlack)
'
End Sub

Public Sub Init()
Dim temp As String
Dim cmd As String
'
'runlog1.logbox.Text = ""
'runlog1.logbox.TextRTF = ""
'
' oh, my! We've got some confusion here!
' The first time that we run, or on demand, we have to initialize both the
' monthly directory and the local working directory. We need to shoot these into the
' registry so we've go them eternally.
'
' As per the discussion below (down a couple of pages) we need to preset the
' defaults to C:\TAGGED for the .PDF files and K:\CLIENTS for the database
' Naturally, this will make debugging a chore
'
target = "C:\X"     'We'll always have a root of C: that we can access!
'
' make the search command line dependent
'
' Got the registry working for the Adobe Executable. Now we need
' to get all of the config params from the registry.
'
' text1(0).text     - Current month drive
' text1(1).text     - 2nd month drive
' text1(2).text     - 3rd month drive
' text1(3).text     - 4th month drive
' text1(4).text     - Beginning Of Time index directory (I:\MASTER)
' Adobe_path        - Home of AcroRD32.EXE
'
Check_registry:
If Len(configure.Text1(5).Text) < 1 Then
    '
    Wait.Label1.Caption = "Please wait," & vbCrLf & "scanning for" & vbCrLf & "Adobe Reader"
    Wait.Show
    Wait.Refresh
    '
    ' Look for file on whatever drive we were started from
    '
    cmd = Environ("comspec") & " /C dir " & Left(CurDir, 2) & "\acrord32.exe /b /s /-p > " & target
        ExecCmd (cmd)       'Scan disk for info
    '
    On Error Resume Next    'Ignore errors for now
    '
    Open target For Input As #1 'Attempt to open file
        Line Input #1, temp         'Read data
    Close
    '
    configure.Text1(5).Text = Trim(temp)    'Clean up input
    '
    ' This is the full registry key that gets created...
    '
    ' HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Sterling & King-EXTRACT\Main
    '
    If Len(configure.Text1(5).Text) > 0 Then         'Shoot result into registry
        SaveSetting App.CompanyName & "-" & App.EXEName, "Main", "Adobe_path", configure.Text1(5).Text
        Adobe_Path = configure.Text1(5).Text        'Shoot into global var
        Call log("Registry Updated: " & configure.Text1(5).Text, "", vbBlack)
    Else
        '
        ' Ok, support program not found, exit as gracefully as possible under
        ' the circumstances
        '
        Call log("Critical Error: Reader not found!", "B", vbRed)
        reply = MsgBox("Unable to continue!" & vbCrLf & "Adobe Reader program not found!" & vbCrLf & "Please install before running " & App.EXEName, vbCritical + vbOKOnly + vbSystemModal, "CRITICAL ERROR!")
        Call die
        '
    End If
Else
    '
    ' Ok, we got a key entry from the registry. Validate
    '
    On Error Resume Next
    X = 0       'X doesn't get updated if next line triggers error
    X = FileLen(configure.Text1(5).Text)     'Is application file there?
    If X < 1000 Then
        '
        ' Oops!, file isn't where we expected it.
        ' Registry must be out of date. Drop our key and then hunt for program
        '
        DeleteSetting App.CompanyName & "-" & App.EXEName, "Main", "Adobe_path"
        configure.Text1(5).Text = ""
        Call log("Registry Updated: " & configure.Text1(5).Text & " deleted", "", vbBlack)
        GoTo Check_registry
        ' =================
    End If
'
End If
'
GoTo drain1                  'Skip over trap
' =================
'
' Here on serious error
'
puke:
Call die            'Flame out
' =====================
' NO RETURN FROM ABOVE!
' =====================
'
drain1:
'
drain:
'
End Sub

Private Sub runlog_Click()
Me.Hide
runlog1.Show
End Sub
0
 

Author Comment

by:ravink
ID: 2731795
Thanks
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now