Yuck. Formatting went out of window,
Option Explicit
'===============================================================
' Module : basRumba
'---------------------------------------------------------------
' Purpose : Automating Rumba sessions from VBA
'
' Author : Neil Murray, Dec 2012
'
' Revision : v1
'
' References: EhlApi32.dll
'---------------------------------------------------------------
' Return values for all these functions should be zero for success
' Run Rumba profile as a session
' Example usage
' nReturnValue = WD_RunProfile("C:\MyRumbaSession.WDU", 1)
Public Declare Function WD_RunProfile Lib "EhlApi32.dll" _
(ByVal Profile As String, ByVal SW_Value As Integer) As Integer
' Connect To Profile Session. Gets handle on session and gives it an instance number
' Example usage
' nReturnValue = WD_ConnectPS(1, "A")
' the session is refered to by instance number 1 for the rest of the code.
' "A" is the shortname for the profile, which is set in the profile's Options>API>Identification
Public Declare Function WD_ConnectPS Lib "EhlApi32.dll" _
(ByVal hInstance As Long, ByVal NameSpace As String) As Integer
' Hide / Show session.
' Example usage
' nReturnValue = nReturnValue = WD_ShowSession(1, 0)' Hides Session
' nReturnValue = nReturnValue = WD_ShowSession(1, 1)' Shows Session
Public Declare Function WD_ShowSession Lib "EhlApi32.dll" _
(ByVal hInstance As Integer, ByVal ShowWindow As Integer) As Integer
' Send Key.
' Example usage
' nReturnValue = WD_SendKey(1, sAnyTextString)
Public Declare Function WD_SendKey Lib "EhlApi32.dll" _
(ByVal hInstance As Long, ByVal KeyData As String) As Integer
' Read Screen
' HoldString needs to be defined initially by filling the string with the
' same number of characters as the scrape.
' Position is the start position on the screen to be read.
' It is calculated by the number of characters in a row.
' If each row has 80 characters (typical) then 81 would indicate row 2, column 1
' Example usage
' Result = String$(6, " ")
' nReturnValue = WD_CopyPSToString(1, 1775, Result, 6)
Public Declare Function WD_CopyPSToString Lib "EhlApi32.dll" _
(ByVal hInstance As Long, ByVal Position As Integer, ByVal HoldString As String, ByVal Length As Integer) As Integer
'Get current cursor location
' Example usage
' nReturnValue = WD_QueryCursorLocation(1, nScreenPos, Result, nLength)
Public Declare Function WD_QueryCursorLocation Lib "EhlApi32.dll" _
(ByVal hInstance As Integer, Location As Integer) As Integer
' Closes session and destroys PID
' Example usage
' nReturnValue = WD_DeletePS(1, "A")
Public Declare Function WD_DeletePS Lib "EhlApi32.dll" _
(ByVal hInstance As Integer, ByVal ShortName As String) As Integer
' Disconnects from Session. WD_ConnectPS is needed after this to regain control of session
' Example usage
' nReturnValue = WD_DisconnectPS(1)
Public Declare Function WD_DisconnectPS Lib "EhlApi32.dll" _
(ByVal hInstance As Long) As Integer
' String Constants for SendKeys
Public Const PA1 As String = "@x"
Public Const PA2 As String = "@y"
Public Const PA3 As String = "@z"
Public Const PA4 As String = "@+"
Public Const ENTER As String = "@E"
Public Const CURSOR_DOWN As String = "@V"
Public Const CURSOR_UP As String = "@U"
Public Const PAGE_DOWN As String = "@v"
Public Const PAGE_UP As String = "@u"
'############# Key list ################
'Meaning Mnemonic
'
'@ @@
'Alt @A
'Alternate Cursor @$
'Attention @A@Q
'Backspace @<
'Backtab (Left Tab) @B
'Clear @C
'Cmd Function Key @A@Y
'Cursor Down @V
'Cursor Left @L
'Cursor Right @Z
'Cursor Select @A@J
'Cursor Up @U
'Delete @D
'Dup @S@x
'End @q
'Enter @E
'Erase EOF @F
'Erase Input @A@F
'Field Exit @A@E
'Field Mark @S@y
'Field - @A@-
'Field + @A@+
'Help @H
'Hexadecimal @A@X
'Home @0 (zero)
'Insert @I
'Insert Toggle @A@I
'Host Print @P
'Left Tab(Back Tab) @B
'New Line @N
'Page Up @u
'Page Down @v
'Print (PC) @A@t
'Record Backspace @A@<
'Reset @R
'Right Tab (Tab) @T
'Shift @S
'Sys Request @A@H
'Tab (Right Tab) @T
'Test @A@C
'PA1 @x
'PA2 @y
'PA3 @z
'PA4 @+
'PA5 @%
'PA6 @&
'PA7 @’
'PA8 @(
'PA9 @)
'PA10 @*
'PF1/F1 @1
'PF2/F2 @2
'PF3/F3 @3
'PF4/F4 @4
'PF5/F5 @5
'PF6/F6 @6
'PF7/F7 @7
'PF8/F8 @8
'PF9/F9 @9
'PF10/F10 @a
'PF11/F11 @b
'PF12/F12 @c
'PF13 @d
'PF14 @e
'PF15 @f
'PF16 @g
'PF17 @h
'PF18 @i
'PF19 @j
'PF20 @k
'PF21 @l
'PF22 @m
'PF23 @n
'PF24 @o
Public Function GetRow(nScreenPos) As Integer
'===============================================================
' Function : GetRow
'---------------------------------------------------------------
' Purpose : gets row from absolute screen position
' Author : N Murray Dec 2012
'---------------------------------------------------------------
GetRow = RoundUp(nScreenPos / 80, 0)
End Function
Public Function GetColumn(nScreenPos) As Integer
'===============================================================
' Function : GetColumn
'---------------------------------------------------------------
' Purpose : gets Column from absolute screen position
' Author : N Murray Dec 2012
'---------------------------------------------------------------
GetColumn = 80 - ((RoundUp(nScreenPos / 80, 0) * 80) - nScreenPos)
End Function
Public Function GetScreenPos(ByVal nRow As Integer, ByVal nColumn As Integer) As String
'===============================================================
' Function : GetScreenPos
'---------------------------------------------------------------
' Purpose : gets absolute screen position from row and column
' Author : N Murray Dec 2012
'---------------------------------------------------------------
GetScreenPos = ((nRow - 1) * 80) + nColumn
End Function
Public Function WaitForCursor(vKey, nCursorRow As Integer, nCursorColumn As Integer, Optional nSeconds As Integer = 10) As Boolean
'===============================================================
' Function : WaitForCursor
'---------------------------------------------------------------
' Purpose : Sends Keys and waits till cursor is in position
' Author : N Murray Dec 2012
'---------------------------------------------------------------
Dim nLoctionTest As Integer, nCursorLocation As Integer, nReturnValue As Integer
Dim dteStart As Date
nReturnValue = WD_SendKey(1, vKey)
dteStart = Now()
nLoctionTest = ((nCursorRow - 1) * 80) + nCursorColumn
Do Until (nLoctionTest = nCursorLocation) Or DateDiff("s", dteStart, Now()) > nSeconds
nReturnValue = WD_QueryCursorLocation(1, nCursorLocation)
Loop
If nLoctionTest = nCursorLocation Then
WaitForCursor = True
Else
WaitForCursor = False
End If
End Function
Public Function Scrape(ByVal nLength As Integer, ByVal nScreenRow As Integer, ByVal nScreenColumn As Integer) As String
'===============================================================
' Function : Scrape
'---------------------------------------------------------------
' Purpose :Scrapes screen for text based on row, column, length
' Author : N Murray Dec 2012
'---------------------------------------------------------------
Dim Result As String, nScreenPos As Integer, nReturnValue As Integer
nScreenPos = ((nScreenRow - 1) * 80) + nScreenColumn
Result = String$(Val(nLength), " ")
nReturnValue = WD_CopyPSToString(1, nScreenPos, Result, nLength)
Scrape = Result
End Function