VBA Not Waiting for Attachmate (OIA.XStatus)

[SnasonJoe]

Long time reader, first time poster:

I've inherited a complex project that involves Excel/VBA interfacing with Attachmate EXTRA! X-treme 8.0. My knowledge of EXTRA is about an inch above nothing; however, I know enough that EXTRA needs some built-in pauses to wait for the clock to reach zero occasionally. The person who built the code wrote a clever function that looks to pause after each instance of Clear or Enter or similar:

Option Base 1
Option Explicit

Dim objExtraSystem As ExtraSystem
Dim objExtraSessions As ExtraSessions
Dim objExtraSession As ExtraSession
Dim objExtraScreen As ExtraScreen
Dim objExtraArea As ExtraArea
Dim objExtraSerialSetup As ExtraConnectivity

Enum sKey
    sKey_Clear = 0
    sKey_Enter
    sKey_PF1
    sKey_PF3
    sKey_PF5
    sKey_POR
End Enum

Function FuncKey(FuncVal As sKey, Optional sRepeat& = 1)
On Error GoTo ErrHnd

Application.EnableCancelKey = xlErrorHandler
Dim StrSND$, strTimer, i&
With objExtraScreen

    Select Case FuncVal
        Case 0: StrSND$ = "<Clear>"
        Case 1: StrSND$ = "<Enter>"
        Case 2: StrSND$ = "<PF1>"
        Case 3: StrSND$ = "<PF3>"
        Case 4: StrSND$ = "<PF5>"
        Case 5: StrSND$ = "<POR>"
    End Select

    For i = 1 To sRepeat
        Dim sTimer
        sTimer = Timer

        If Not FuncVal = 5 Then Do Until objExtraScreen.OIA.XStatus = 0 And objExtraScreen.OIA.ErrorStatus = 0: Loop
        .SendKeys StrSND$

        Do Until objExtraScreen.OIA.XStatus = 0 And objExtraScreen.OIA.ErrorStatus = 0: Loop

        If FuncVal = 1 Then
            Do Until Not objExtraScreen.GetString(1, 1, 33) = "** EMPLOYEE POLICY NOT ALLOWED **" _
                 And Not objExtraScreen.GetString(1, 2, 30) = "COMMAND SUCCESSFULLY COMPLETED": Loop
        End If
        Do While objExtraScreen.OIA.XStatus <> 0: Loop
        
        If FuncVal = 5 Then Do Until Trim(objExtraScreen.GetString(21, 9, 43)) = "Enter the sign-on for your application ===>": Loop
    Next
    
End With

ErrExit:
Exit Function

ErrHnd:
If Err = 18 Then
    End
Else
    MsgBox Err.Number & ": " & Err.Description
    Resume ErrExit
End If

End Function

And although it is pausing, it's not pausing long enough or in the right places. Can someone take a look at the code and tell me if it should work? I'd be happy to post more code if that would help. At this time, I'm trying to compare a number from an Excel report with the number in EXTRA, if they match it outputs "match" to the report; if they don't match it outputs whatever is in EXTRA. It works some time but invariably skips rows and outputs errors occasionally.

 

[SkipVought]

Hi,

You never call this function, so how could it do anything for you.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SnasonJoe]

I thought I'd have to include the initiating code too. Here it is (abbreviated):

Sub UpdateData()
Dim ct As String, cn As String, pn As String, dt As String, cnmatch As String, conf As String, error As String
Dim cnt As Long, iWait As Long, i As Long, pcnt As Long, endRow As Long
Dim DEM As clsDEMExtra

Set DEM = New clsDEMExtra
        For cnt = 2 To Range("B999").End(xlUp).Row
            
            ' CUSTOMER NUMBER
            cn = Cells(cnt, 2)
            ' Clear existing data
            'Worksheets("Scrap").Range("B2:D999").ClearContents
            'Worksheets("Scrap").Range("B2").Value = cn
            ' POLICY NUMBER
            pn = Cells(cnt, 3)
            If Len(pn) < 7 Then
                Cells(cnt, 7).Value = "bad policy #"
                GoTo NextRecord
            End If
            ' DATE
            dt = Format(Cells(cnt, 4), "mmddyy")
            ' CONSUMER TYPE
            ct = Cells(cnt, 5)
                
            DEM.FuncKey sKey_Clear ' <--- CALLS FuncKey FUNCTION FROM ABOVE POST
            DEM.Key "PABC " & pn
            DEM.FuncKey sKey_Enter ' <--- CALLS FuncKey FUNCTION FROM ABOVE POST
            
            conf = Mid(DEM.RawScreen(1), 63, 7)
            If conf <> "HANOVER" Then
                error = Trim(Mid(DEM.RawScreen(1), 46, 100))
                Cells(cnt, 7).Value = error
                DEM.FuncKey sKey_Clear
            Else
                cnmatch = Mid(DEM.RawScreen(11), 30, 10)
                If cnmatch = cn Then
                    Cells(cnt, 7).Value = "match"
                    DEM.FuncKey sKey_Clear
                Else
                    Cells(cnt, 7).Value = "no match"
                    DEM.FuncKey sKey_Clear
                End If
            End If
            ' (Remaining code removed from this example)
End Sub

 

[SkipVought]

shouldn't these have values 0 thru 5?

Enum sKey
    sKey_Clear = 0
    sKey_Enter
    sKey_PF1
    sKey_PF3
    sKey_PF5
    sKey_POR
End Enum

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SnasonJoe]

It's my understanding the remaining constants are "assigned incrementing values starting at the last explicit value" (p 63 from Access 2002 Desktop Developer's Handbook, Litwin, Getz, Gunderloy).

 

[SkipVought]

Ah, I do see that in my reference.

This is the problem with looking at snippets of code: It cannot be tested cuz its incomlpete.

I use Attachmate Extra, and with Attachmate Extra there is no Extra application object as you seem to assign to DEM. SendKeys is a function of a SCREEN, which is an object in a SESSION, which is an object in an Extra SYSTEM...

'
'I code in Excel VBA, so these are my declarations at the modula level
'
Public oSystem As ExtraSystem
Public oSessions As ExtraSessions
Public oSess As ExtraSession
Public oScrn As ExtraScreen
'
'....... these are in my MAIN procedure, assigning the primary Attachmate Extra objects, where the oScrn is the only screen in the terminal emulator.
'
    Set oSystem = CreateObject("Extra.System")
    
    Set oSess = oSystem.Sessions.Open("C:\Program Files\E!PC\Sessions\Mainframe.edp")

    With oSess
        .Visible = True
        .WindowState = xNORMAL
    End With

    Set oScrn = oSess.SCREEN

I'd suggest that you STEP thru your code and OBSERVE [highlight]the value[/[highlight]] that the FuncKey function is setting.



Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]