AS400 SendKeys not sending data to screen

[bigeldm]

I have a very simple module that connects to AS400 and sends "022" to the screen but the "022" never shows up on the screen when I run this. I know I'm making a connection because the gettext line returns data.

What am I missing? Any help wuld be greatly appreciated. TX

Here is the code
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public autECLSession As Object
Public autECLPS As Object
Public autECLOIA As Object
Sub ObjGetExtra()
Set autECLSession = CreateObject("pcomm.auteclsession")
Set autECLPS = CreateObject("Pcomm.auteclps")
Set autECLOIA = CreateObject("Pcomm.autecloia")
autECLSession.SetConnectionByName ("A")
autECLSession.autECLPS.SetCursorPos 24, 17
autECLSession.autECLPS.SendKeys ("022")
autECLSession.autECLOIA.WaitForInputReady
autECLSession.autECLPS.SendKeys "[enter]"
autECLSession.autECLOIA.WaitForInputReady
MsgBox autECLSession.autECLPS.GetText(6, 7, 15)
End Sub

 

[Scuderia]

Hi
This may or may not help...

When I used to do this albeit with a different module and syntax, the code would often move a lot faster than the screen draws. To allow for this we would precede any text sent to the AS400 by a command similar to your "autECLSession.autECLOIA.WaitForInputReady" or a command which would wait a specified time for the cursor to enter a specific position

It looks to me as though this maybe happening with your code above

 

[bigeldm]

Thanks - tried that and I get the same results.

 

[mkvarious]

When I used to do this albeit with a different module and syntax, the code would often move a lot faster than the screen draws. To allow for this we would precede any text sent to the AS400 by a command similar to your "autECLSession.autECLOIA.WaitForInputReady" or a command which would wait a specified time for the cursor to enter a specific position

Hi bigeldm, Scuderia,

What Scuderia says is valid although this will not always help AS400 to receive data. If it was the reason of AS400 responsing too late then begeldm you could try and test different time delays as suggested by Scuderia.
In our company lots of work is done by excel cooperating with AS400 and in most cases I have seen we are only using
PCOMM.autECLOIA.WaitForInputReady (2000) option.
The number in brackets you can manipulate with and (?) probably it is miliseconds. Think this can be also seconds etc. and can probably be decalred but we simply use miliseconds - you can search through internet if it is important for you.

As stated, in our company we change it from 2000 to 4000 or 5000 when AS400 needs longer time period for complete something (say you pressed F8 button to update records). Even have seen macro that was recorderd on AS400 emulator and it was using
10 000 miliseconds - do not know whether there is any upper limit but I'd be surprised, if there was.

This is quite lame solution, though. Not addressing Scuderia suggestion but saying for me it not always works properly as simply time period may be too short and you will only know that once you've encountered the problem with your code...
I think better approach is to read ON SCREEN whether you reached desired new screen or not.
The problem is you cannot always use that option and will explain why it is not always working.
Best is to manually check on AS400 where you should be taken to if something was typed manually and then in your code try to see using GetText (for one line) or GetTextRect (for squares) whether you reached this screen or not in the desired X Y positions. Then you can simply add some Ifs Eles, Select Case or whatever and the job is done.

Now, sometimes is not always working as in case of one screen to be filled with data in a couple of fields you need to move the cursor and this is the problem when you have to move it, somewhere. So this is when bigeldm and my problems are close
When I have just 2 fields to fill data with then I use SendKeys with tabulator and it works (cursor moves from one to the other).
But when I have many fields to fill data in on one screen then when I try tabulator to move cursor from one position to other and alhough it was working in debug then when I run my macro it then does not move to the position as in case of debugger!

bigeldm,
see below maybe it will solve your problem if you have just one field or two to SendKeys to:
The difference I can see between your code and codes used in our company is we use SendKeys with position we want it sent to:
PCOMM.autECLPS.SendKeys "25/OE1", 21, 11

Oviously, I am no programmer just self-learner so apologies for any potential mistakes or unprofessional solutions

cheers,

 

[mkvarious]

Well, just to be exact I should probably also say that these are not the only options I have learned about but just wanted to post the previous as maybe it will be clearer for bigeldm.

I have skimmed through PCCOM emulator help file but it only confused me.
First of all, help file gives examples of wait options but it is in VBScript not VBA so for someone like me it is not that easy to transform from one to the other.
Nevertheless the above, help file states there are wait conditions that work only when cursor stays at a place (while cursor at) or only start when cursor moves to (until cursor at).
the second is supposed to be the solution to my problems as help file states: until the cursor moves to (cursor row, cursor column), the session waits.

VBScript example to wait until cursor is displayed at row 2, column 9 on the screen:

''exec23
[enter]
[wait sys]
wait until cursor at (2,9)
''exec24
[enter]

The thing is I cannot neither find on the web nor figure it out how to use them in VBA.
I have tried to type:
autECLSession.autECLOIA.WaitForCursorAt
but it did not work and was suggesting syntax error.
Then I think I added position in brackets but then it also did not work.
autECLSession.autECLOIA.WaitForCursorAt (2,17)

Can someone advise?

 

[bigeldm]

I have verified that the cursor position is correct by using gettext at the location where I am trying to put the text as you suggest. I have used the cursor location as a separate line and inline with the send keys, I have added a wait, but nothing still writes to the screen. The screen is a simple menu screen that has one ENTER OPTION# ___ field - I am just trying to write 022 to this screen and send enter. None of it is working. Is there any way you could share with me a sample of some of the code you are working with?

Public autECLSession As Object
Public autECLPS As Object
Public autECLOIA As Object
Sub ObjGetExtra()
Set autECLSession = CreateObject("pcomm.auteclsession")
Set autECLPS = CreateObject("pcomm.auteclps")
Set autECLOIA = CreateObject("pcomm.autecloia")
End Sub

Sub InputTest()
Dim strLogin As String
Dim Sess As String
Dim vtest As String
'strLogin = "USRSP7"
Call ObjGetExtra
autECLSession.SetConnectionByName ("A")
autECLSession.autECLOIA.WaitForInputReady
autECLSession.autECLPS.SendKeys "022", 24, 17
autECLSession.autECLOIA.WaitForInputReady
autECLSession.autECLPS.SendKeys "[Enter]"
MsgBox autECLSession.autECLPS.GetText(6, 15, 39)

End Sub

 

[mkvarious]

sure, I can share the code but the variables are in Polish as well as comments and messagebox texts - please do not ask me to translate it from Polish to English

ption Explicit
Public wbk1 As Workbook, wbk2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
Public cVis As Range '''copy_from, copy_to As Range
Sub sample_JBA()
'''dodaje sample do JBA, zamiast wpisywania do 10/OE2 JBAP
Dim lOstatniWiersz, lOWiersz As Long, licznik As Long, n As Long, błąd As Long, poprawny As Long
Dim popraw, niepoprawna As String, sesja As String, zczytuj As String, zczytuj2 As String, wynik As String
If bZłyWiersz = True Or bZłaKolumna = True Then
    popraw = MsgBox("Zaznacz dane w kolumnie A i wybierz wiersz/wiersze w obrębie zakresu danych, poza wierszami 1 i 2.", _
    vbOKOnly + vbInformation, "Zły wybór")
    Exit Sub
Else
    '''najpierw sprawdzam, czy mamy poprawne dane w zaznaczonym zakresie, dopiero potem
    '''nastąpi wprowadzanie danych do JBA
    For Each cVis In Selection
        If cVis.Value = "" Or cVis.Offset(0, 5).Value = "" Or cVis.Offset(0, 5).Value = 0 Then
            popraw = MsgBox("W wierszu nr " & cVis.Row & " znaleziono puste komórki lub wartość zerową." _
            & Chr(13) & "Wprowadź nr katalogowy w kolumnie A i ilość sztuk w kolumnie F.", vbOKOnly + _
            vbCritical, "Brak danych lub niepoprawne dane")
            Exit Sub
        End If
        If Not IsNumeric(cVis.Offset(0, 5).Value) Then
            popraw = MsgBox("W wierszu nr " & cVis.Row & " wprowadzono wartość nie numeryczną w kolumnie F.", _
            vbOKOnly + vbCritical, "Niepoprawne dane")
            Exit Sub
        End If
    Next cVis
    'Set wbk1 = Workbooks("CEO WEEKLY SHIPMENTS")
    Set ws1 = Sheets("shipments")
    If ws1.FilterMode = True Then ws1.ShowAllData
    '''ustalenie rodzaju kompanii i sesji JBA
    sesja = [C1] '''oznaczenie sesji w lokalnym JBA
    Dim SO As String
    Dim ps, ia
    Set ps = CreateObject("PCOMM.autECLPS")
    Set ia = CreateObject("PCOMM.autECLOIA")
    ps.SetConnectionByName (sesja)
    ia.SetConnectionByName (sesja)
    ps.autECLFieldList.Refresh
    ia.WaitForInputReady (2000)
    zczytuj = ps.GetTextRect(1, 16, 1, 17)
    If zczytuj = "P9" Then
        popraw = MsgBox("Przeloguj się do lokalnego JBA (88) i ponownie uruchom makro", _
        vbOKOnly + vbCritical, "Niewłaściwa kompania JBA")
        Exit Sub
    End If
    zczytuj2 = ps.GetTextRect(1, 18, 1, 19)
    If zczytuj2 = "88" Then
        If Trim(ps.autECLFieldList(1).GetText) <> "AM0V" Then
            popraw = MsgBox("Wróć do ekranu głównego i ponownie uruchom makro", _
            vbOKOnly + vbCritical, "Niewłaściwy ekran w JBAP")
            Exit Sub
        End If
    Else
        popraw = MsgBox("Nie znaleziono sesji określonej w komórce C1." & Chr(13) & _
        "Zaloguj się do lokalnego JBA (88), sprawdź wybraną sesję i ponownie uruchom makro.", _
        vbOKOnly + vbCritical, "Błąd")
        Exit Sub
    End If
    '''wprowadzanie danych do 10/OE2 JBAP
    AppActivate "Session " + sesja
    ps.SendKeys "10/OE2", 21, 11
    ia.WaitForInputReady (2000)
    ps.SendKeys "[enter]"
    
    For Each cVis In Selection
        'licznik = licznik + 1
        n = 0
zawróć:
        ia.WaitForInputReady (2000)
        n = n + 1
        If n = 2000 Then
            popraw = MsgBox("Makro wpadło w pętlę w skutek błędu JBA i zatrzymało się przy itemie z wiersza nr " & _
            cVis.Row & ".", vbOKOnly + vbCritical, "Błąd JBA")
            cVis.Font.Color = -16776961
            Exit Sub
        End If
        If ps.GetTextRect(2, 19, 2, 37) <> "Add samples for CEO" Then GoTo zawróć
        ps.SendKeys cVis.Value, 4, 14
        ia.WaitForInputReady (2000)
        ps.SendKeys "[enter]"
        ia.WaitForInputReady (2000)
        If ps.GetTextRect(17, 5, 17, 33) = "Item not exist in Parts file." Then
            ps.SendKeys "[pf8]"
        End If
        n = 0
zawracaj:
        ia.WaitForInputReady (4000)
        n = n + 1
        If n = 2000 Then
            popraw = MsgBox("Makro wpadło w pętlę w skutek błędu JBA i zatrzymało się przy itemie z wiersza nr " & _
            cVis.Row & ".", vbOKOnly + vbCritical, "Błąd JBA")
            cVis.Font.Color = -16776961
            Exit Sub
        End If
        If ps.GetTextRect(7, 5, 7, 24) <> "Add samples for CEO?" Then GoTo zawracaj
        ps.SendKeys "Y", 7, 26
        ia.WaitForInputReady (2000)
        ps.SendKeys "   ", 10, 37
        ia.WaitForInputReady (2000)
        Select Case cVis.Offset(0, 5).Value
            Case cVis.Offset(0, 5).Value = 1 To 9
                ps.SendKeys cVis.Offset(0, 5).Value, 10, 39
                ia.WaitForInputReady (2000)
            Case cVis.Offset(0, 5).Value = 10 To 10
                ps.SendKeys cVis.Offset(0, 5).Value, 10, 38
                ia.WaitForInputReady (2000)
        End Select
        ps.SendKeys "[pf8]"
        n = 0
powróć:
        ia.WaitForInputReady (4000)
        '''poniższy if dodany, bo w testowym JBA pojawił się taki błąd - w live chyba to jednak nie występuje
        If ps.GetTextRect(14, 5, 14, 28) = "Error: item not updated." Then
            cVis.Font.Color = -16776961
            popraw = MsgBox("Makro napotkało błąd JBA i dla itemu z wiersza numer " & cVis.Row & _
            " nie mogło zarequestować sampli dla CEO." & Chr(13) & _
            "Naciśnij OK w celu kontynuowania dodawania sampli dla pozostałych itemów.", _
            vbOKOnly + vbInformation, "Błąd JBA")
            ps.SendKeys "[pf12]"
            ia.WaitForInputReady (4000)
            błąd = błąd + 1
        ElseIf ps.GetTextRect(14, 5, 14, 30) = "Item updated successfully." Then
            poprawny = poprawny + 1
        ElseIf ps.GetTextRect(17, 5, 17, 51) = "Samples have already produced for this FG item." Then
            popraw = MsgBox("JBA wykrył, że sample w ilości " & ps.GetTextRect(8, 35, 8, 36) & _
            " sztuk zostały już zarequestowane dla itemu z wiersza numer " & cVis.Row & "." & Chr(13) & Chr(13) & _
            "Czy chcesz ponownie dodać sample?", vbYesNo + vbQuestion, "Sample już zarequestowane")
            Select Case popraw
                Case Is = 6         '''YES
                    ps.SendKeys "[pf8]"
                    ia.WaitForInputReady (4000)
                    poprawny = poprawny + 1
                Case Is = 7         '''NO
                    ps.SendKeys "[pf12]"
                    ia.WaitForInputReady (4000)
                    ps.SendKeys "[pf12]"
                    ia.WaitForInputReady (4000)
                    'cVis.Font.Color = -16776961
            End Select
        Else
            popraw = MsgBox("Makro wpadło w pętlę w skutek błędu JBA i zatrzymało się przy itemie z wiersza nr " & _
            cVis.Row & ".", vbOKOnly + vbCritical, "Błąd JBA")
            cVis.Font.Color = -16776961
            Exit Sub
        End If
        n = n + 1
        If n = 2000 Then
            popraw = MsgBox("Makro wpadło w pętlę w skutek błędu JBA i zatrzymało się przy itemie z wiersza nr " & _
            cVis.Row & ".", vbOKOnly + vbCritical, "Błąd JBA")
            cVis.Font.Color = -16776961
            Exit Sub
        End If
        If ps.GetTextRect(4, 14, 4, 28) <> "               " Then GoTo powróć
    Next cVis
    ps.SendKeys "[pf3]"
    
    Select Case poprawny
        Case Is = 0
            wynik = MsgBox _
            ("Wystąpił błąd JBA lub zrezygnowano z requestowania sampli i w rezultacie makro nie dodało sampli dla żadnego itemu." _
            , vbOKOnly + vbInformation, "Wynik")
        Case Is = 1
            Select Case błąd
                Case Is = 0
                    wynik = MsgBox("Zarequestowano sample dla 1 zaznaczonego itemu.", vbOKOnly + _
                    vbInformation, "Wynik")
                Case Is = 1
                    wynik = MsgBox("Zarequestowano sample dla 1 itemu." & Chr(13) & _
                    "Dla itemu zaznaczonego na czerwono nie udało się zarequestować sampli.", _
                    vbOKOnly + vbInformation, "Wynik")
                Case Is > 1
                    wynik = MsgBox("Zarequestowano sample dla 1 itemu." & Chr(13) & _
                    "Dla itemów zaznaczonych na czerwono nie udało się zarequestować sampli.", _
                    vbOKOnly + vbInformation, "Wynik")
            End Select
        Case Is > 1
            Select Case błąd
                Case Is = 0
                    wynik = MsgBox("Zarequestowano sample dla " & poprawny & " zaznaczonych itemów.", vbOKOnly _
                    + vbInformation, "Wynik")
                Case Is = 1
                    wynik = MsgBox("Zarequestowano sample dla " & poprawny & " zaznaczonych itemów." & Chr(13) & _
                    "Dla itemu zaznaczonego na czerwono nie udało się zarequestować sampli.", _
                    vbOKOnly + vbInformation, "Wynik")
                Case Is > 1
                    wynik = MsgBox("Zarequestowano sample dla " & poprawny & " zaznaczonych itemów." & Chr(13) & _
                    "Dla itemów zaznaczonych na czerwono nie udało się zarequestować sampli.", _
                    vbOKOnly + vbInformation, "Wynik")
            End Select
    End Select
End If
End Sub

 

[mkvarious]

to explain it a bit:

first I select some cells and for these cells in selection

For Each cVis In Selection

how I work with it is I have labels "zawróć:", "zawracaj:" or "powróć:" (go back) to which code gets back when GetTextRect does not find text that I have been expecting to.
also I have a counter that stops the routing when counter is equal 2000 times (not miliseconds this time ) so that it does not loop endlessly.

please let me know if you want me to explain it a bit more.

 

[mkvarious]

... being so chaotic, apologies but I am actually at work, now!

just wanted to add this code is working fine with no issues with AS400 - this was the other code I reffered to when I said that tabulators pressed a couple of times did not work properly (although they do work in degub, as I said).

 

[mkvarious]

hi bigeldm,

I have my problem solved with the below code that keeps pressing tab button until cursor position is located at X & Y.
I first declare where a cursor should be and and if it is not there then I set variables which row it should be (wymaganyW) and which column it should be (wymaganaK).

    If ps.CursorPosRow <> 14 Or ps.CursorPosCol <> 75 Then
        wymaganyW = 14
        wymaganaK = 75
        Call move_cursor
    End If

Then I call separate procedure which moves the cursor till it has reached desired X Y cursor position

Sub move_cursor()
Dim v As Long
v = 0
kolejny_raz:
v = v + 1
If v = 30000 Then
    popraw = MsgBox(Prompt:="JBAC zbyt długo nie odpowiada, makro kończy działanie", _
    Buttons:=vbOKOnly + vbExclamation, Title:="Błąd JBAC")
    Exit Sub
End If
ps.SendKeys "[tab]"
ia.WaitForInputReady (2000)
'''MsgBox ps.CursorPosRow & "," & ps.CursorPosCol
If ps.CursorPosRow <> wymaganyW Or ps.CursorPosCol <> wymaganaK Then
    GoTo kolejny_raz
Else
    '''MsgBox "mamy wreszcie wymagany wiersz nr: " & wymaganyW & " i wymaganą kolumnę nr: " & wymaganaK & _
    " i równają się one z: " & ps.CursorPosRow & " oraz z: " & ps.CursorPosCol
End If
End Sub

As for your issue I do not think I will be able to help out anymore as when I have checked the first code you posted here and it worked for me.
Therefore my guess is it is not a macro issue but rather AS400 emulator being blocked, somehow? I am sure there are more wise guys than me when it comes to such things but this is the only explanation that suits me, taking into account your code writes "022" for me and not for you...
good luck!

cheers,
mkvarious