I have a VBA Code that makes A AS-400 Program look for something especific, this program is IBM Reflections (Host50 Extra! X-treme), This Code Works Perfect, But now we are forcing a new version of this program and now the code doesnt work, we have some PCs with the Old system and they all work, As soon as you try it on the new version it gives you an error.
I get caught in the middle, I dont know how to use that program and i didnt build this Code, But now in being pressured to fix it .... What should I be looking for here?
The Error I get is : Automation Error, Invalid Syntax, And the Step by Step Stops at the Red lettering arrow
I Really appreciate your Help.
Private Sub Command26_Click()
On Error GoTo Err_Command26_Click
MsgBox "GO TO AS-400, " & Chr(10) & _
"AND CLICK (OK) TO CONTINUE" & Chr(10) & _
" " & Chr(10) & _
"CLEAN SCREEN !!"
Dim Robj1 As Object
Set Robj1 = GetObject("RIBM") <--------- Where the Step By Step Stops and send me to the error MSG
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