Upgraded from IBM 3270 to Extra! X-treme now VBA Codes Wont Work 1

[Cevaes]

Hello Everyone, Im New here this is my first Thread/Post, Im glad to be here and hope to contribute with the little I know.

Im also new this challenging but beautiful world of programming

Ok, So Also im new at my current Job lol, havent interacted with their as400 system yet, but still they want me to program vba around it.

We have plenty of Access Files with Vba Coding that interact (pulls info) from a IBM 3270 Terminal (AS-400), Everything worked great until they decided it was time to upgrade this application. (to Extra! X-treme 9.2)

Now The same file, works only on the old machines, On new PCS it gives me an automatic "Automation Error, Invalid Syntax"

I did some researh and found out that the old way of coding wont work with this new version.

Example Of Old Coding (Still works on PCS with Old IBM 3270 Terminal):
(NOTE: I believe This was done via Macro Recorder on the as400 system then pasted on the VBA)


Private Sub Command26_Click()
On Error GoTo Err_Command26_Click

MsgBox "GO TO SECORE, " & Chr(10) & _
"AND CLICK (OK) TO CONTINUE" & Chr(10) & _
" " & Chr(10) & _
"CLEAN SCREEN !!"

Dim Robj1 As Object
Set Robj1 = GetObject("RIBM")
Robj1.Connect

'** Prepare the database:

'Dim db As Database, rs As Recordset, rs2 As Recordset
'Dim I As Integer

'Dim TIME_STARTED, TIME_COMPLETED
'Dim ACCOUNTS_OK, ACCOUNTS_ERR

TIME_STARTED = Time()

Set db = CurrentDb
Set rs = db.OpenRecordset("TableField11A") '<------------- Type Table or excel file name Name

'rs.MoveLast

'txtTotRecs = rs.RecordCount
rs.MoveFirst

DoEvents

With Robj1
'** Start the main loop:



Do While Not rs.EOF



'** SCREEN # 1 START ***


'1ST CASH TRANSACTION (CE credit)*****************************
'1ST CASH TRANSACTION (CE credit)*****************************
.TransmitTerminalKey rcIBMPf3Key
.TransmitTerminalKey rcIBMPf3Key

Do While .getdisplaytext(24, 7, 1) <> "E"

.TransmitANSI "SIMM " & rs!Reference
.TransmitTerminalKey rcIBMEnterKey
.WaitForEvent rcEnterPos, "30", "0", 6, 2
.WaitForDisplayString "ACTION", "30", 23, 2
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'esta como 1

If .getdisplaytext(7, 78, 3) = "REV" Then ' littler by little
.TransmitTerminalKey rcIBMTabKey
.TransmitANSI "ret "
.TransmitTerminalKey rcIBMEnterKey
rs.MoveNext
.TransmitANSI "SIMM " & rs!Reference
.TransmitTerminalKey rcIBMEnterKey
'.WaitForEvent rcEnterPos, "30", "0", 6, 2
.WaitForDisplayString "ACTION", "30", 23, 2
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
End If
'Do While .getdisplaytext(7, 78, 3) <> "REV"
.SetMousePos 6, 2
.TerminalMouse rcLeftClick, rcMouseRow, rcMouseCol
.GraphicsMouse rcLeftClick, rcCurrentGraphicsCursorX, rcCurrentGraphicsCursorY
.TransmitANSI "mx03"
.TransmitTerminalKey rcIBMEnterKey
'.WaitForEvent rcEnterPos, "30", "0", 23, 10
'.WaitForDisplayString "ACTION", "30", 23, 2
.WaitForEvent rcKbdEnabled, "30", "0", 1, 0 'esta como 1
If .getdisplaytext(5, 2, 3) = "543" Or .getdisplaytext(5, 2, 3) = "541" Then
'.TransmitTerminalKey rcIBMEnterKey
'.TransmitTerminalKey rcIBMTabKey
'.SetMousePos 23, 10
'.TerminalMouse rcLeftClick, rcMouseRow, rcMouseCol
'.GraphicsMouse rcLeftClick, rcCurrentGraphicsCursorX, rcCurrentGraphicsCursorY
.TransmitANSI "MX"
.TransmitTerminalKey rcIBMEnterKey
'.TransmitTerminalKey rcIBMPf3Key
'.SetMousePos 15, 3
'.TerminalMouse rcLeftClick, rcMouseRow, rcMouseCol
'.GraphicsMouse rcLeftClick, rcCurrentGraphicsCursorX, rcCurrentGraphicsCursorY
.WaitForEvent rcKbdEnabled, "30", "1", 1, 0
'rcCopySelectionItem = .getdisplaytext(15, 3, 20)
If .getdisplaytext(15, 3, 3) = "11A" Then
VARreference = .getdisplaytext(15, 8, 10) & "."
rs.edit
rs!Field11A = VARreference
rs.Update
End If
If .getdisplaytext(14, 3, 3) = "11A" Then
VARreference = .getdisplaytext(14, 8, 10) & "."
rs.edit
rs!Field11A = VARreference
rs.Update
End If
If .getdisplaytext(16, 3, 3) = "11A" Then
VARreference = .getdisplaytext(16, 8, 10) & "."
rs.edit
rs!Field11A = VARreference
rs.Update
End If
If .getdisplaytext(18, 3, 3) = "11A" Then
VARreference = .getdisplaytext(18, 8, 10) & "."
rs.edit
rs!Field11A = VARreference
rs.Update
End If
If .getdisplaytext(19, 3, 3) = "11A" Then
VARreference = .getdisplaytext(19, 8, 10) & "."
rs.edit
rs!Field11A = VARreference
rs.Update
End If


End If

rs.MoveNext
Loop
Loop

'***** END OF MACRO **************

On Error Resume Next
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
On Error GoTo 0

Read_Next_Account:
Dim ct As Single

txtNumRecs = ACCOUNTS_ERR + ACCOUNTS_OK
ct = ct + 1
DoEvents
End With
FINISH:

rs.Close

'DoCmd.Hourglass (0)

'DoCmd.RunMacro ("Export")

TIME_COMPLETED = Time()

MsgBox "IMPORT COMPLETED !!!!" & Chr(10) & _
" " & Chr(10) & _
"STARTED: " & TIME_STARTED & " COMPLETED: " & TIME_COMPLETED

'DoCmd.RunMacro ("mcr RD REPORT")


Exit_Command26_Click:
Exit Sub

Err_Command26_Click:
MsgBox Err.Description
Resume Exit_Command26_Click

End Sub


Ok, So I did some research and changed the code to start like this:


Dim Sessions As Object
Dim System As Object
Set System = CreateObject("EXTRA.System")
If (System Is Nothing) Then
MsgBox "Could not create the EXTRA System object. Stopping macro playback."
Stop
End If
Set Sessions = System.Sessions

If (Sessions Is Nothing) Then
MsgBox "Could not create the Sessions collection object. Stopping macro playback."
Stop
End If
' Set the default wait timeout value
g_HostSettleTime = 3000 ' milliseconds

OldSystemTimeout& = System.TimeoutValue
If (g_HostSettleTime > OldSystemTimeout) Then
System.TimeoutValue = g_HostSettleTime
End If

' Get the necessary Session Object
Dim Sess0 As Object
Set Sess0 = System.ActiveSession
If (Sess0 Is Nothing) Then
MsgBox "Could not create the Session object. Stopping macro playback."
Stop
End If
If Not Sess0.Visible Then Sess0.Visible = True
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)

Set Screen = System.ActiveSession.Screen


Now it doesnt give me that error, Its actually communicating to the AS400 side but it would stop right after its time for the AS400 to start doing its work, its like it doesnt understand what i want it to do.(since the coding was recorded on the old version)

I could record a new macro and copy/paste the Code but i dont know how to use it or understand the logics of it yet.(I know, I know but here they just expect you to know everyhting)

but I learned that if i changed this:
.TransmitTerminalKey rcIBMPf3Key

to this:
Sess0.Screen.SendKeys ("<Pf3>")

or this:
Do While .getdisplaytext(24, 7, 1) <> "E"

to this:
Sess0.Screen.GetString(24, 7, 1) <> "E"

Then the AS400 understood and actually did it. so that tells me that i need to update ALL the coding, but theres a lot of other commands to change that is overwhelming

So I was wondering if there was a tutorial with all the commands or a easier way where I could update/transform the old code to new code that AS400 can understand.

THAANNKKKSSSS

 

[SkipVought]

Check the FAQs in this forum & forum99.

A comment regarding a WAIT for a sprecific duration:

Would you determine before driving your car, that you will stop at each intersection for 5 seconds and then proceed through the intersection? NO! Because the actions in the intersection are ASYNCHRONOUS with the function of your vehicle. Likewise your AS400 acts asynchronously with your terminal; it may respond in 1 second, 1 minute, 1 hour--who knows?

Something like this would be preferable:

SendKeys
Do Until WaitForCursor([i]cursor rest coordinates[/i])
  DoEvents
Loop

 

[Cevaes]

Yeah, That makes sense, Im almost 100 percent sure that Code was a copy and paste from the macro recorder inside reflection 3270.