Results 1 to 7 of 7
  1. #1
    CeVaEs_64 is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Oct 2014
    Posts
    29

    Post IBM Reflections HOST 40 Question

    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

    Last edited by CeVaEs_64; 01-13-2015 at 12:35 PM. Reason: edited

  2. #2
    rpeare is offline VIP
    Windows XP Access 2003
    Join Date
    Jul 2011
    Posts
    5,442
    Are you running this from MS excel?

    Also.... do you have the appropriate activeX component checked off in your references on the 'new' computer when you have your vba window open?

    You can check the references on the working computers by clicking TOOLS>REFERENCES in the VBA window, make sure those same references are present in the 'new' computer. If they aren't or aren't available you'll have to find the right one in the list of references or install the correct one.

  3. #3
    rpeare is offline VIP
    Windows XP Access 2003
    Join Date
    Jul 2011
    Posts
    5,442
    There's another method here:

    http://visualbasic.ittoolbox.com/gro...e-3270-4660764

    using slightly different code which leads me to believe, if the references are identical, you actually need to install some software to be able to use the code you're using or it has been replaced/invalidated with the newer operating systems.

  4. #4
    CeVaEs_64 is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Oct 2014
    Posts
    29
    Quote Originally Posted by rpeare View Post
    Are you running this from MS excel?

    Also.... do you have the appropriate activeX component checked off in your references on the 'new' computer when you have your vba window open?

    You can check the references on the working computers by clicking TOOLS>REFERENCES in the VBA window, make sure those same references are present in the 'new' computer. If they aren't or aren't available you'll have to find the right one in the list of references or install the correct one.
    Im using it on Access 2010, I will take a look at that link and see, I do have the same References as well, I though that it had something to to with the new version of the software instead of something on the Access Side

  5. #5
    CeVaEs_64 is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Oct 2014
    Posts
    29
    Well, The Error Went away with me replacing the beggining of the code right after the MSG box with 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)

    But now it would always tell me that theres no records, and i dont see the AS400 Program doing anything like it does on the older version...

    More to dig =/

  6. #6
    rpeare is offline VIP
    Windows XP Access 2003
    Join Date
    Jul 2011
    Posts
    5,442
    I would change all those msgbox's to debug.print statements so your code doesn't get interrupted, you can view the debug statements in the IMMEDIATE window of your vba (ctrl-g if it's not visible)

    I assume that none of those msgbox's are popping up and it's doing everything correctly up to that point?

    Are you trying to call your as400 program after the code you just posted? because I don't see anything I recognize as cycling through records.

  7. #7
    CeVaEs_64 is offline Novice
    Windows 8 Access 2010 32bit
    Join Date
    Oct 2014
    Posts
    29
    Quote Originally Posted by rpeare View Post
    I would change all those msgbox's to debug.print statements so your code doesn't get interrupted, you can view the debug statements in the IMMEDIATE window of your vba (ctrl-g if it's not visible)

    I assume that none of those msgbox's are popping up and it's doing everything correctly up to that point?

    Are you trying to call your as400 program after the code you just posted? because I don't see anything I recognize as cycling through records.

    I believe i found another thing, Before the keys were actioned like this (when the Program didnt do anything) :

    .TransmitTerminalKey rcIBMTabKey Now they are actioned like this (like this i can actually see the Program Doing whats being asked):

    Sess0.Screen.SendKeys ("<Tab>")

    Do now i will have to figure out what is what ans replace eerrrthing here, But hey at least im making progress

    I already Erased the MSG box, but it was showing, since the error in the code was past that point.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Unlink accdb from dead host
    By rockyjb1 in forum Access
    Replies: 11
    Last Post: 01-23-2014, 04:02 PM
  2. Replies: 4
    Last Post: 08-25-2012, 07:19 PM
  3. Host a back end on a web server.
    By thekruser in forum Programming
    Replies: 1
    Last Post: 10-06-2010, 09:34 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums