×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

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

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

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

(OP)
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

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

Check the FAQs in this forum & forum99: AttachMate solutions.

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:

CODE

SendKeys
Do Until WaitForCursor(cursor rest coordinates)
  DoEvents
Loop 

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

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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close