VBA Reflection

Micro Focus Reflection Desktop is a desktop mainframe emulation application. VBA is embedded in Reflection Desktop and can also be accessed from Office applications using the Micro Focus Reflection API.

Installing Micro Focus Reflection Desktop should provide access to the libraries needed to work with the Micro Focus Reflection API:

Set references to each library from Tools → References.

Attachmate.Reflection.Objects.tlb
Attachmate.Reflection.Objects.Emulation.IbmHosts.tlb
Attachmate.Reflection.Objects.Emulation.OpenSystems.tlb
Attachmate.Reflection.Objects.Framework.tlb

IBM Host Session Automation

Often times, solutions are based around automating front-end screens. Common tasks include scraping data from a screen, inputting or removing data, and clicking buttons or sending keys. It can be useful to develop a light framework to facilitate this type of work. Implementation details can be abstracted away and the development of front-end automation solutions can be expedited. A working framework could include an AutomationObject to serve as a wrapper for common objects and tasks, an Error Handling module to assist with error handling, and a Screen Handling module to manage multiple screens. Next, a module can be created for each screen that is part of the solution to handle the activity and data for that particular screen.

Automation Object

A wrapper class can be created to facilitate working with the Micro Focus Reflection API. The class can be used to initialize and maintain objects as well as provide a simplified API to the end user.

The wrapper class should contain references to the following objects:

Attachmate_Reflection_Objects_Framework.ApplicationObject
Attachmate_Reflection_Objects.Frame
Attachmate_Reflection_Objects.View
Attachmate_Reflection_Objects_Emulation_IbmHosts.IbmTerminal
Attachmate_Reflection_Objects_Emulation_IbmHosts.IbmScreen

Option Explicit

'Meta Data========================================================================
'=================================================================================
' Module Type: Class
' Module Name: clsMainframeAutomationObject
' Module Description: Wrapper class to facilitate working with Reflection API
' Application Version Used: Micro Focus Reflection Desktop Pro (x64) 16.1


'Constants========================================================================
'=================================================================================
Private Const CURSOR_TIMEOUT& = 15000
Private Const KEYBOARD_ENABLED_TIMEOUT& = 15000


'Private Fields===================================================================
'=================================================================================
Private pApp      As Attachmate_Reflection_Objects_Framework.ApplicationObject
Private pFrame    As Attachmate_Reflection_Objects.Frame
Private pView     As Attachmate_Reflection_Objects.View
Private pTerminal As Attachmate_Reflection_Objects_Emulation_IbmHosts.IbmTerminal
Private pScreen   As Attachmate_Reflection_Objects_Emulation_IbmHosts.IbmScreen


'Initialize and Terminate=========================================================
'=================================================================================
Public Function Init(ViewTitleText$) As Boolean

    'App
    On Error Resume Next
    Set pApp = GetObject("Reflection Workspace")
    On Error GoTo 0
    If pApp Is Nothing Then
        Init = False
        MsgBox "Error in getting Reflection Application Object"
        Exit Function
    End If

    'Frame
    Set pFrame = pApp.GetObject("Frame")

    'View
    Set pView = pFrame.GetViewByTitleText(ViewTitleText)
    If pView Is Nothing Then
        MsgBox "Unable to get view: " & _
        ViewTitleText, vbOKOnly + vbCritical
        Exit Function
    End If

    'Terminal
    Set pTerminal = pView.Control

    'Screen
    Set pScreen = pTerminal.Screen

    'All objects set
    Init = True

End Function

Private Sub Class_Terminate()
    Set pScreen = Nothing
    Set pTerminal = Nothing
    Set pView = Nothing
    Set pFrame = Nothing
    Set pApp = Nothing
End Sub


'Private Procedures===============================================================
'=================================================================================
Private Function GetReturnCodeString$(RC As Attachmate_Reflection_Objects.ReturnCode)

    Select Case RC

        Case ReturnCode.ReturnCode_Cancelled
            GetReturnCodeString = "ReturnCode_Cancelled"

        Case ReturnCode.ReturnCode_Error
            GetReturnCodeString = "ReturnCode_Error"

        Case ReturnCode.ReturnCode_PermissionRequired
            GetReturnCodeString = "ReturnCode_PermissionRequired"

        Case ReturnCode.ReturnCode_Success
            GetReturnCodeString = "ReturnCode_Success"

        Case ReturnCode.ReturnCode_Timeout
            GetReturnCodeString = "ReturnCode_Timeout"

        Case ReturnCode.ReturnCode_Truncated
            GetReturnCodeString = "ReturnCode_Truncated"

    End Select

End Function


'Public Properties================================================================
'=================================================================================
Public Property Get App() _
As Attachmate_Reflection_Objects_Framework.ApplicationObject
    Set App = pApp
End Property

Public Property Get Frame() _
As Attachmate_Reflection_Objects.Frame
    Set Frame = pFrame
End Property

Public Property Get View() _
As Attachmate_Reflection_Objects.View
    Set View = pView
End Property

Public Property Get Terminal() _
As Attachmate_Reflection_Objects_Emulation_IbmHosts.IbmTerminal
    Set Terminal = pTerminal
End Property

Public Property Get Screen() _
As Attachmate_Reflection_Objects_Emulation_IbmHosts.IbmScreen
    Set Screen = pScreen
End Property

Public Property Get Initialized() As Boolean
    Initialized = Not pApp Is Nothing
End Property


'Public Procedures================================================================
'=================================================================================

Public Function GetRowText$(RowNumber&)
    GetRowText = _
    pScreen.GetText(RowNumber, 1, pScreen.Columns)
End Function

Public Function ScreenRowContainsText(ScreenRow&, ScreenText$) As Boolean
    ScreenRowContainsText = _
    InStr(GetRowText(ScreenRow), ScreenText) > 0
End Function

Public Function GetScreenText$(RowNumber&, ColumnNumber&, TextLength&)
    GetScreenText = _
    pScreen.GetText(RowNumber, ColumnNumber, TextLength)
End Function

Public Function ClearField(RowNumber&, ColumnNumber&) As Boolean

    Dim RC As Attachmate_Reflection_Objects.ReturnCode

    'Move Cursor to Row, Column
    RC = pScreen.MoveCursorTo1(RowNumber, ColumnNumber)
    If RC <> ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "MoveCursorTo1 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Cursor
    RC = pScreen.WaitForCursor1(CURSOR_TIMEOUT, RowNumber, ColumnNumber)
    If RC <> ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForCursor1 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Keyboard
    RC = pScreen.WaitForKeyboardEnabled(KEYBOARD_ENABLED_TIMEOUT, 0)
    If RC <> ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForKeyboardEnabled did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Send Erase EOF Key
    RC = pScreen.SendControlKey(KeyCode:=ControlKeyCode_Erase_Eof)
    If RC <> ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "SendControlKey did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Keyboard
    RC = pScreen.WaitForKeyboardEnabled(KEYBOARD_ENABLED_TIMEOUT, 0)
    If RC <> ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForKeyboardEnabled did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    ClearField = True

End Function

Public Function SetCursorPosition(RowNumber&, ColumnNumber&) As Boolean

    Dim RC As Attachmate_Reflection_Objects.ReturnCode

    'Move Cursor to Row, Column
    RC = pScreen.MoveCursorTo1(RowNumber, ColumnNumber)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "MoveCursorTo1 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Cursor
    RC = pScreen.WaitForCursor1(CURSOR_TIMEOUT, RowNumber, ColumnNumber)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError MainframeAutomationErrorMethodFailed, _
        "WaitForCursor1 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    SetCursorPosition = True

End Function

Public Function SendTextToScreen(Text$) As Boolean

    Dim RC As Attachmate_Reflection_Objects.ReturnCode

    'Wait for Keyboard
    RC = pScreen.WaitForKeyboardEnabled(KEYBOARD_ENABLED_TIMEOUT, 0)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForKeyboardEnabled did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Send Keys
    RC = pScreen.SendKeys(Text)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "SendKeys did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Keyboard
    RC = pScreen.WaitForKeyboardEnabled(KEYBOARD_ENABLED_TIMEOUT, 0)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForKeyboardEnabled did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    SendTextToScreen = True

End Function

Public Function PutTextToScreen(ByVal Text$, RowNumber&, ColumnNumber&) As Boolean

    Dim RC As Attachmate_Reflection_Objects.ReturnCode

    'Move Cursor to Row, Column
    RC = pScreen.MoveCursorTo1(RowNumber, ColumnNumber)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "MoveCursorTo1 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Cursor
    RC = pScreen.WaitForCursor1(CURSOR_TIMEOUT, RowNumber, ColumnNumber)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForCursor1 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Put Text
    RC = pScreen.PutText2(Text, RowNumber, ColumnNumber)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "PutText2 did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Keyboard
    RC = pScreen.WaitForKeyboardEnabled(KEYBOARD_ENABLED_TIMEOUT, 0)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForKeyboardEnabled did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    PutTextToScreen = True

End Function

Public Function SendKeyToScreen(KeyCode As ControlKeyCode) As Boolean

    Dim RC As Attachmate_Reflection_Objects.ReturnCode

    'Send Key
    RC = pScreen.SendControlKey(KeyCode)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "SendControlKey did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    'Wait for Keyboard
    RC = pScreen.WaitForKeyboardEnabled(KEYBOARD_ENABLED_TIMEOUT, 0)
    If RC <> ReturnCode.ReturnCode_Success Then
        RaiseMainframeError _
        MainframeAutomationErrorMethodFailed, _
        "WaitForKeyboardEnabled did not succeed. ReturnCode: " & _
        GetReturnCodeString(RC)
    End If

    SendKeyToScreen = True

End Function

Error Handling Module

The Error Handling module can be used to provide an enumeration of error types that can be raised when an automation solution ends up in an unacceptable state such as being on the wrong screen or a method failing.

Option Explicit

'Meta Data========================================================================
'=================================================================================
' Module Type: Standard
' Module Name: modMainframeErrors
' Module Description: Module to handle errors
'=================================================================================
'=================================================================================

Public Enum MainframeAutomationError
    MainframeAutomationErrorMethodFailed = vbObjectError + 513
    MainframeAutomationErrorUnexpectedScreen
End Enum

Public Sub RaiseMainframeError(MFAError As MainframeAutomationError, Description$)
    Err.Raise MFAError, Description:=Description
End Sub

Screen Handling Module

The Screen Handling module can be used to provide an enumeration of available screens, constants defining identifiers for each screen, and a validation function which can be used to ensure the application is on the correct screen before calling particular functions.

Option Explicit

'Meta Data========================================================================
'=================================================================================
' Module Type: Standard
' Module Name: modScreenHandling
' Module Description: Module to handle screens
'=================================================================================
'=================================================================================

Public Enum MainframeScreenCode
    MainframeScreenCodeExampleScreen1 = 1
    MainframeScreenCodeExampleScreen2
    MainframeScreenCodeExampleScreen3
End Enum

Public Const SCREEN_CODE_EXAMPLE_1 As String = "ABC 123"
Public Const SCREEN_CODE_EXAMPLE_2 As String = "DEF 456"
Public Const SCREEN_CODE_EXAMPLE_3 As String = "GHI 789"

Public Function ValidateScreen(MFAO As clsMainframeAutomationObject, _
ScreenCode As MainframeScreenCode) As Boolean

    Select Case ScreenCode

        Case MainframeScreenCodeExampleScreen1
            ValidateScreen = (MFAO.GetScreenText(1, 1, 7) = SCREEN_CODE_EXAMPLE_1)

        Case MainframeScreenCodeExampleScreen2
            ValidateScreen = (MFAO.GetScreenText(1, 1, 7) = SCREEN_CODE_EXAMPLE_2)

        Case MainframeScreenCodeExampleScreen3
            ValidateScreen = (MFAO.GetScreenText(1, 1, 7) = SCREEN_CODE_EXAMPLE_3)

    End Select

End Function

Screen Model Modules

Each screen can be modelled in its own module to provide public functions and data members that pertain to that particular screen, as well as a visual sample of the screen.

Option Explicit

'Meta Data========================================================================
'=================================================================================
' Module Type: Standard
' Module Name: screenExample
' Module Description: Module to represent a mainframe screen
'=================================================================================
'=================================================================================

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  ABC 123                      Generic Company                   01/01/2021
'
'
'   Text Input:
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'  F2 Submit
' ---------------------------------------------------------------------------
'                                                                   1, 1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub EnterTextInput(MFAO As clsMainframeAutomationObject, Text As String)

    If Not ValidateScreen(MFAO, MainframeScreenCodeExampleScreen1) Then
        RaiseMainframeError _
        MainframeAutomationErrorUnexpectedScreen, _
        "Must be on screen ABC 123"
    End If

    MFAO.ClearField 4, 14

    MFAO.PutTextToScreen Text, 4, 14

End Sub

Public Sub Submit(MFAO As clsMainframeAutomationObject)

    If Not ValidateScreen(MFAO, MainframeScreenCodeExampleScreen1) Then
        RaiseMainframeError _
        MainframeAutomationErrorUnexpectedScreen, _
        "Must be on screen ABC 123"
    End If

    MFAO.SendKeyToScreen ControlKeyCode_F2

End Sub

Example Solution

The automation object is instantiated once and passed to various functions instead of having each function retrieve the reflection application object on its own. The screen is validated before calling functions on the example screen so functions are not erroneously run on the incorrect screen. Next, the screen model module is used to call functions relating to the particular screen. The result of using the framework is simplified and shortened code for a single solution, improved efficiency with regard to instantiating objects, and improved security with validation and error handling.

Option Explicit

Public Sub EnterTextAndSubmit()

    Dim MFAO As clsMainframeAutomationObject

    Set MFAO = New clsMainframeAutomationObject

    If Not MFAO.Init("ExampleViewTitle.rd3x") Then
        MsgBox "clsMainframeAutomationObject not initialized.", vbCritical
        Exit Sub
    End If

    If Not ValidateScreen(MFAO, MainframeScreenCodeExampleScreen1) Then
        MsgBox "Must start on ExampleScreen1", vbCritical
        Exit Sub
    End If

    screenExample.EnterTextInput MFAO, "Hello, World!"
    screenExample.Submit MFAO

    Set MFAO = Nothing

End Sub