Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub MAIN
End Sub
Public Function Run5250Macro(arr5250Fields() As String,l5250CursorRow As Long,l5250CursorCol As Long,sWordAtCursorLoc As String) As Long
'--------------------------------------------------------
'Function: Run5250Macro
'Desc. . : This function is called from the RJS 5250
' Integrator along with all field information
' from the selected screen. User logic can
' be applied to parse the screen fields and
' then call a selected application based on
' criteria found on the 5250 screen.
'--------------------------------------------------------
On Error GoTo Errors
Dim RtnCode As Long
Dim sEntireScreen As String
Dim VendorNumber As String
Dim VendorName As String
Dim VendorPO As String
Dim VendorInvoice As String
'--------------------------------------------------------
'Roll through each screen field and add to entire screen field
'This is used for illustration, but who knows, you may
'find a real use for this :-)
'--------------------------------------------------------
For screenline = 1 To UBound(arr5250Fields) -1
If Trim(arr5250Fields(screenline)) <> "" Then
sEntireScreen = sEntireScreen & arr5250Fields(screenline) & vbCrLf
End If
Next screenline
'MsgBox sEntireScreen
'MsgBox Mid$(arr5250Fields(2),2,6)
'--------------------------------------------------------
'--------------------------------------------------------
'Check 5250 data lines to determine which program to call
'--------------------------------------------------------
'--------------------------------------------------------
'MsgBox "Cursor is currently at Row:" & l5250CursorRow & " Col:" & l5250CursorCol & " Word found is:" & sWordAtCursorLoc
'''Test ShellExecute
'''RtnCode = ShellExecute(0&, "open", "notepad.exe", "", "", vbNormalFocus)
'--------------------------------------------------------
'We are on the AS/400 - iSeries signon screen
'Grab 5250 screen line 1, positions 36-42 and line 2, positions 48-53
'--------------------------------------------------------
If Mid$(arr5250Fields(1),36,7) = "Sign On" And Mid$(arr5250Fields(2),48,6) = "System" Then
'Display message box
MsgBox "This is the signon screen. Let's launch Notepad",vbInformation Or vbMsgBoxSetForeground,"On the Signon Screen"
'Run Windows notepad
RtnCode = ShellExecute(0&, "open", "c:\winnt\notepad.exe", "", "", vbNormalFocus)
'--------------------------------------------------------
'We are on the AS/400 main menu (GO MAIN)
'Grab 5250 screen line 1, positions 2-6
'--------------------------------------------------------
ElseIf Mid$(arr5250Fields(1),2,4) = "MAIN" Then
'Display message box
MsgBox "This is the main menu",vbInformation Or vbMsgBoxSetForeground,"Main Menu Selected"
'Run Windows notepad
RtnCode = ShellExecute(0&, "open", "c:\winnt\notepad.exe", "", "", vbNormalFocus)
'--------------------------------------------------------
'We are on the AS/400 WRKOUTQ screen (WRKOUTQ)
'--------------------------------------------------------
ElseIf Mid$(arr5250Fields(1),30,22) = "Work with Output Queue" Then
'Display message box
''MsgBox "This is output queue " & Trim(Mid$(arr5250Fields(3),37,10)) & "/" & Trim(Mid$(arr5250Fields(3),11,10)),vbInformation Or vbMsgBoxSetForeground ,"WRKOUTQ Screen Selected"
RtnCode = ShellExecute(0&, "open", "http://125.1.1.53:1080/IMAGESERVER/DOC100R?action=init", "", "", vbNormalFocus)
'--------------------------------------------------------
'Grab manifest number
'--------------------------------------------------------
ElseIf Mid$(arr5250Fields(1),61,5) = "IN135" Then
'RtnCode = ShellExecute(0&, "open", "http://www.rjssoft.com", "", "", vbNormalFocus)
MsgBox Mid$(arr5250Fields(10),4,14)
'--------------------------------------------------------
'We are on the A/P Sample Screen - AP001P
'Grab 5250 screen line 2, positions 2-7
'--------------------------------------------------------
ElseIf Mid$(arr5250Fields(2),2,6) = "AP001P" Then
'***************************************
'Grab vendor number and name to work with
'***************************************
VendorName=Mid$(arr5250Fields(7),2,13)
VendorNumber=Mid$(arr5250Fields(7),17,6)
VendorPO=Trim(Mid$(arr5250Fields(l5250CursorRow),15,9))
VendorInvoice=Trim(Mid$(arr5250Fields(l5250CursorRow),73,7))
'***************************************
'Run search if column before PO# at position 15
'***************************************
'MsgBox CStr(l5250CursorCol)
If l5250CursorCol >= 15 Then
'***************************************
'Pass screen values to URL search
'***************************************
'Vendor# Search
'MsgBox CStr(l5250CursorCol)
If l5250CursorRow = 7 Then
RtnCode = ShellExecute(0&, "open", "http://125.1.1.53:1080/IMAGESERVER/DOC100R?action=Search&SRCHFLD01=" & Trim(VendorNumber), "", "", vbNormalFocus)
'PO Number Search
ElseIf l5250CursorCol >=15 And l5250CursorCol <= 22 Then
RtnCode = ShellExecute(0&, "open", "http://125.1.1.53:1080/IMAGESERVER/DOC100R?action=Search&SRCHFLD03=" & Trim(VendorPO), "", "", vbNormalFocus)
'Invoice Search
ElseIf l5250CursorCol >=73 And l5250CursorCol <= 79 Then
RtnCode = ShellExecute(0&, "open", "http://125.1.1.53:1080/IMAGESERVER/DOC100R?action=Search&SRCHFLD04=" & Trim(VendorInvoice), "", "", vbNormalFocus)
Else
MsgBox "No search criteria chosen at column " & l5250CursorCol
End If
Else 'No areas defined
'***************************************
'Pass screen values to scan workstation
'***************************************
MsgBox "No search criteria defined for this area of the screen.
End If
'--------------------------------------------------------
'We are on the Image Server/400 screen, launch RJS Scanning
'--------------------------------------------------------
ElseIf Mid$(arr5250Fields(1),2,8) = "RJSIMAGE" Then
'Display message box
Call RJSLaunchScanning()
'--------------------------------------------------------
'No program selected to run
'--------------------------------------------------------
Else
MsgBox "No program was selected to run",vbInformation Or vbMsgBoxSetForeground,"No Program Selected"
MsgBox sEntireScreen,vbInformation Or vbMsgBoxSetForeground,"Entire 5250 Screen Data"
End If
Run5250Macro = 0 'Normal Exit
'--------------------------------------------------------
' Normal Exit
'--------------------------------------------------------
Normal:
On Error Resume Next
Exit Function
'--------------------------------------------------------
' Handle Errors
'--------------------------------------------------------
Errors:
Run5250Macro =Err.Number 'Set error
MsgBox Err.Number & " " & Err.Description
Resume normal
End Function
Function RJSLaunchScanning() As Long
'--------------------------------------------------------
'Function: RunLaunchScanning
'Desc. . : Launch RJS Imaging Scan Workstation
'Key Properties:
'.DocFolder = Document Folder Title
'.DocFolderEnabled - (0=Enabled, 1=Protected)
'.DocTitle = Document Title
'.DocTitleEnabled - (0=Enabled, 1=Protected)
'.DocType = Document Type Desc
'.DocTypeEnabled - (0=Enabled, 1=Protected)
'.DocIndex01 - .DocIndex10
'.DocIndex01Enabled - .DocIndex10Enabled - (0=Enabled, 1=Protected)
'--------------------------------------------------------
Dim objRJSSCAN As Object
'Launch RJS Imagng Scan Workstation
Set objRJSSCAN = CreateObject("RJSImageScanWorkstation.CLSRJSImageScan")
'Set temp TIFF image
With objRJSSCAN
.SaveAsFileName = "C:\RJSTEMPIMAGE.TIF"
.OLEServerMode = True
.FILEinsert "C:\TIFF\ANNOT.TIF"
End With
End Function
Function RJSLaunchAPScanning(Vendor As String,VendorName As String,PO As String,Invoice As String) As Long
'--------------------------------------------------------
'Function: RunLaunchAPScanning
'Desc. . : Launch RJS Imaging Scan Workstation
'Key Properties:
'.DocFolder = Document Folder Title
'.DocFolderEnabled - (0=Enabled, 1=Protected)
'.DocTitle = Document Title
'.DocTitleEnabled - (0=Enabled, 1=Protected)
'.DocType = Document Type Desc
'.DocTypeEnabled - (0=Enabled, 1=Protected)
'.DocIndex01 - .DocIndex10
'.DocIndex01Enabled - .DocIndex10Enabled - (0=Enabled, 1=Protected)
'--------------------------------------------------------
Dim objRJSSCAN As Object
'Launch RJS Imagng Scan Workstation
Set objRJSSCAN = CreateObject("RJSImageScanWorkstation.CLSRJSImageScan")
'Set temp TIFF image
With objRJSSCAN
.SaveAsFileName = "C:\RJSTEMPIMAGE.TIF"
.OLEServerMode = True
'Keep program open after scan calls
Call .CloseStandAlone(True)
.DocFolder="URM Stores"
.DocType="Accounts Payable"
.DocTitle = "AP Invoice"
.DocIndex01=Vendor
.DocIndex02=VendorName
.DocIndex03=PO
.DocIndex04=Invoice
.RefreshIndexFields
'.Display(True)
.ScanImage
End With
End Function
Function RJSScrapeValues() As Long
'--------------------------------------------------------
'Function: RunLaunchAPScanning
'Desc. . : Launch RJS Imaging Scan Workstation
'Key Properties:
'.DocFolder = Document Folder Title
'.DocFolderEnabled - (0=Enabled, 1=Protected)
'.DocTitle = Document Title
'.DocTitleEnabled - (0=Enabled, 1=Protected)
'.DocType = Document Type Desc
'.DocTypeEnabled - (0=Enabled, 1=Protected)
'.DocIndex01 - .DocIndex10
'.DocIndex01Enabled - .DocIndex10Enabled - (0=Enabled, 1=Protected)
'--------------------------------------------------------
Dim objRJSSCAN As Object
'Launch RJS Imagng Scan Workstation
Set objRJSSCAN = CreateObject("RJSImageScanWorkstation.CLSRJSImageScan")
'Set temp TIFF image
'With objRJSSCAN
' .SaveAsFileName = "C:\RJSTEMPIMAGE.TIF"
' .OLEServerMode = True
' 'Keep program open after scan calls
' Call .CloseStandAlone(True)
' .DocFolder="URM Stores"
' .DocType="Accounts Payable"
' .DocTitle = "AP Invoice"
' .DocIndex01=Vendor
' .DocIndex02=VendorName
' .DocIndex03=PO
' .DocIndex04=Invoice
' .RefreshIndexFields
' '.Display(True)
' .ScanImage
'End With
'Set temp TIFF image
With objRJSSCAN
.SaveAsFileName = "C:\RJSTEMPIMAGE.TIF"
.OLEServerMode = True
'Keep program open after scan calls
Call .CloseStandAlone(False)
.DocFolder="Test Folder"
.DocType="No Document Type"
'.DocFolder="Root Folder/Documents"
'.DocType="Student Info"
.DocTitle = "AP Invoice"
.DocIndex01=Vendor
.DocIndex02=VendorName
.DocIndex03=PO
.DocIndex04=Invoice
.RefreshIndexFields
.Display(True)
'.ScanImage
End With
End Function
