VBA causing excel to freeze

[Vik12]

Hello,

I have the following vba code running from excel which interacts with the Mainframe perfectly.

'
' Global variable declarations
Public g_HostSettleTime%
Public g_szPassword$
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub PlanGroups()


'--------------------------------------------------------------------------------
' Get the main system object
    Dim Sessions As Object
    Dim System As Object
    
    If MsgBox("Is your mainframe is on screen TOP MNU? Do you have access to PCMB03?", vbYesNo) = vbNo Then

Exit Sub
End If
    


    Set System = GetObject("", "EXTRA.System")
        If System Is Nothing Then
            Set System = CreateObject("EXTRA.System")
    If (System Is Nothing) Then
        MsgBox "Could not create the EXTRA System object.  Stopping macro playback."
        Stop
    End If
        End If
    Set System = CreateObject("EXTRA.System")   ' Gets the system object
    If (System Is Nothing) Then
        MsgBox "Could not create the EXTRA System object.  Stopping macro playback."
        Stop
    End If
    
    Set Sessions = System.Sessions.Open("C:\Program Files (x86)\E!PC\Sessions\Mainfrme.edp")
        If Sessions Is Nothing Then
            Set Sessions = System.Sessions.Open("C:\Program Files (x86)\E!PC\Sessions\Mainframe.edp")
            If MySession Is Nothing Then
                Response = MsgBox("Could not create the EXTRA Session object", vbCritical, "EXTRA Session")
                End
            End If
        End If
        
     
'--------------------------------------------------------------------------------
' Set the default wait timeout value
    g_HostSettleTime = 30       ' 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

 
 'paste macro below
Worksheets("ADD PLANNING GROUPS").Activate

If Application.CountA(Range("A9")) = 0 Then
            MsgBox "PLEASE ENTER VALID DATA STARTING FROM ROW 9!"
            Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

            Exit Sub

End If



Sheets("ADD PLANNING GROUPS").Cells(1, 1).Value = Sess0.Screen.GetString(2, 3, 7)

If Not Sheets("ADD PLANNING GROUPS").Cells(1, 1) = ("TOP MNU") Then
    MsgBox "You are not in TOP MNU...Liar."
    Sheets("ADD PLANNING GROUPS").Cells(1, 1).Clear
    Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

    Exit Sub
    End If
Sheets("ADD PLANNING GROUPS").Cells(1, 1).Clear



If IsEmpty(Sheets("ADD PLANNING GROUPS").Cells(8, 4).Value) Then
    MsgBox "Enter a valid Mainframe ID."
Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

    Exit Sub
    End If


Sess0.Screen.MoveTo 24, 72
Sess0.Screen.SendKeys ("PCMB03<PF2>")
  Do While Sess0.Screen.OIA.Xstatus <> 0
    DoEvents
    Loop



    Dim rngFoundG As Range
    
    With Sheets("ADD PLANNING GROUPS")
        Set rngFoundG = .Columns("A:A").Find("", After:=.Range("A8"), _
            SearchDirection:=xlDown)
        
    End With




Dim PlanGroup As String
Dim MainFrameID As String
MainFrameID = Sheets("ADD PLANNING GROUPS").Cells(8, 4).Value
Sleep (50)
Sess0.Screen.MoveTo 6, 25
Sess0.Screen.SendKeys (MainFrameID & "<ENTER>")
Sheets("ADD PLANNING GROUPS").Cells(8, 5).Value = Sess0.Screen.GetString(6, 38, 30)


LastCell = rngFoundG.Row - 1

For i = 9 To LastCell
Sleep (50)
PlanGroup = Format(Cells(i, "A").Value, "0000")
Sess0.Screen.MoveTo 10, 38
    Sess0.Screen.SendKeys ("<EraseEOF>" & PlanGroup & "<Enter>")
  Do While Sess0.Screen.OIA.Xstatus <> 0
    DoEvents
    Loop
    Sess0.Screen.SendKeys ("<PF12>")
  Do While Sess0.Screen.OIA.Xstatus <> 0
    DoEvents
    Loop
    Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = Sess0.Screen.GetString(23, 2, 17)
       If Not Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = "UPDATE SUCCESSFUL" Then
       Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = "Error"
   End If
Next
Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing
Set rngFoundG = Nothing

    
    MsgBox "Done!"
End Sub

However, the issue after one run through, which is flawless, after approximately 10-15 seconds, excel freezes and needs to be manually closed down. Is there any reason for this? From my research I have set my variables and objects to nothing but this still does not help.

Thank you!

 

[SkipVought]

hi,

Observations:

IsEmpty "Returns a Boolean value indicating whether a variable has been initialized." You are using this incorrectly. Rather...

'
    With Worksheets("ADD PLANNING GROUPS")
'     all your code preceding

      [b]If Trim(.Cells(8, 4).Value) = "" Then

[/b]'     all following code
    End With

You might have a problem here. A null string ("") is not the same as an empty cell.

'
    Dim rngFoundG As Range
    
    With Sheets("ADD PLANNING GROUPS")
        Set rngFoundG = .Columns("A:A").Find("", After:=.Range("A8"), _
            SearchDirection:=xlDown)
        
    End With

...so if you maintain control over the data in your table in sheet Add Planning Groups, this will give you the last row containing data on the sheet...

'
    With Worksheets("ADD PLANNING GROUPS")
'     all your code preceding

    [b]lastcell = .UsedRange.Rows.Count
[/b]
'     all following code
    End With

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Hi Skip,

I have made the suggestions as you said, but my issue is still arising. Any other suggestions?

 

[SkipVought]

Have you tried stepping through your code?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Yes, it works perfectly. The code runs fine, its only until a while later everything freezes.

 

[SkipVought]

Could you please post your current code.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Here you go!

'
' Global variable declarations
Public g_HostSettleTime%
Public g_szPassword$
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub PlanGroups()


'--------------------------------------------------------------------------------
' Get the main system object
    Dim Sessions As Object
    Dim System As Object
    
    If MsgBox("Is your mainframe is on screen TOP MNU? Do you have access to PCMB03?", vbYesNo) = vbNo Then

Exit Sub
End If
    


    Set System = GetObject("", "EXTRA.System")
        If System Is Nothing Then
            Set System = CreateObject("EXTRA.System")
    If (System Is Nothing) Then
        MsgBox "Could not create the EXTRA System object.  Stopping macro playback."
        Stop
    End If
        End If
    Set System = CreateObject("EXTRA.System")   ' Gets the system object
    If (System Is Nothing) Then
        MsgBox "Could not create the EXTRA System object.  Stopping macro playback."
        Stop
    End If
    
    Set Sessions = System.Sessions.Open("C:\Program Files (x86)\E!PC\Sessions\Mainfrme.edp")
        If Sessions Is Nothing Then
            Set Sessions = System.Sessions.Open("C:\Program Files (x86)\E!PC\Sessions\Mainframe.edp")
            If MySession Is Nothing Then
                Response = MsgBox("Could not create the EXTRA Session object", vbCritical, "EXTRA Session")
                End
            End If
        End If
        
     
'--------------------------------------------------------------------------------
' Set the default wait timeout value
    g_HostSettleTime = 30       ' 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

 
 'paste macro below
Worksheets("ADD PLANNING GROUPS").Activate

If Application.CountA(Range("A9")) = 0 Then
            MsgBox "PLEASE ENTER VALID DATA STARTING FROM ROW 9!"
            Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

            Exit Sub

End If



Sheets("ADD PLANNING GROUPS").Cells(1, 1).Value = Sess0.Screen.GetString(2, 3, 7)

If Not Sheets("ADD PLANNING GROUPS").Cells(1, 1) = ("TOP MNU") Then
    MsgBox "You are not in TOP MNU...Liar."
    Sheets("ADD PLANNING GROUPS").Cells(1, 1).Clear
    Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

    Exit Sub
    End If
Sheets("ADD PLANNING GROUPS").Cells(1, 1).Clear

With Worksheets("ADD PLANNING GROUPS")
If Trim(.Cells(8, 4).Value) = "" Then
    MsgBox "Enter a valid Mainframe ID."
Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

    Exit Sub
    End If
End With


Sess0.Screen.MoveTo 24, 72
Sess0.Screen.SendKeys ("PCMB03<PF2>")
  Do While Sess0.Screen.OIA.XStatus <> 0
    DoEvents
    Loop








Dim PlanGroup As String
Dim MainFrameID As String
MainFrameID = Sheets("ADD PLANNING GROUPS").Cells(8, 4).Value
Sleep (50)
Sess0.Screen.MoveTo 6, 25
Sess0.Screen.SendKeys (MainFrameID & "<ENTER>")
Sleep 100
Sheets("ADD PLANNING GROUPS").Cells(8, 5).Value = Sess0.Screen.GetString(6, 38, 30)



    LastCell = Worksheets("ADD PLANNING GROUPS").UsedRange.Rows.Count

For i = 9 To LastCell
Sleep (50)
PlanGroup = Format(Cells(i, "A").Value, "0000")
Sess0.Screen.MoveTo 10, 38
    Sess0.Screen.SendKeys ("<EraseEOF>" & PlanGroup & "<Enter>")
  Do Until Sess0.Screen.OIA.XStatus = 0
    DoEvents
    Loop
    Sess0.Screen.SendKeys ("<PF12>")
    Do Until Sess0.Screen.OIA.XStatus = 0
    DoEvents
    Loop
    Sleep 100
    Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = Sess0.Screen.GetString(23, 2, 17)
     Sleep 100
       If Not Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = "UPDATE SUCCESSFUL" Then
       Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = "Error"
   End If
Next
Set System = Nothing
Set Sessions = Nothing
Set Sess0 = Nothing

    
    MsgBox "Done!"
End Sub

 

[SkipVought]

You seem to have a problem here.

    Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = Sess0.Screen.GetString(23, 2, 17)
     Sleep 100
       If Not Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = "UPDATE SUCCESSFUL" Then
       Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = "Error"
   End If

Let's look at the message that you have assigned to Cells(I,2).Value
[pre]
----+---10----+---20
123456789012345678
UPDATE SUCCESSFUL
[/pre]
So EVERY row that came from a screen that has UPDATE SUCESSFUL should be overwritten with Error.

I'd capture the entire MESSAGE LINE (2, 80)...

Sheets("ADD PLANNING GROUPS").Cells(i, 2).Value = [b]Trim(Sess0.Screen.GetString(23, 2, 80))[/b]

Why so you have all those SLEEP commands??? I have NEVER used a Sleep function, certainly not in any Extra code.

I'd COMMENT them out and see what happens.


Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Hi Skip,

Thanks for the feedback.

The intention of the code is to collect the 17 length string from coordinates 23,2 going rightwards (which should say "UPDATE SUCCESSFUL"). If I get the entire line and trim this, it will collect other information and text which is not needed. The main aim is to copy the string to a cell, check whether the cell says "UPDATE SUCCESSFUL", and if it doesn't replace the value of the cell with error and exit the macro.

With regards to the sleep function, I had set this up in order to slow down the macro, since it was going faster than the getstring, copy & paste functions which created errors amongst the code. I did try to use the

application.wait

possibility, however this again froze excel during the run time of the Macro.

Any other advice is appreciated!

 

[SkipVought]

Sorry about the UPDATE SUCESSFUL. That was a brainless tangent. What was I thinking???

However, on the wait time:

1) you have no .Copy/.Paste anywhere in the code you posted.

2) your code finishes one line of code before processing the next. You might try assigning a variable for each GetString() and then assign the variable to the cell. I doubt if that will help but I've been wrong before (let me think...)

The only place where a delay is required is when you send off a command to the mainframe, since the mainframe process is asynchronous with your VBA code which is synchronous (i.e. The next line will not start before that line completes its process.)



Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Hi Skip,

I see there is no copy/paste's, my turn to have a brainless tangent....

However, I have made your suggested changes with the get string (assigning a variable to the string, then assigning the variable to the cell). I have also removed all the 'sleeps', however the code did not work properly, so again I have had to insert some sleep functions in for a very small time period and only one or two (after each getstring, since it needed more time to compute). However, it does still freeze unfortunately but I haven't had a chance to test it as much and in-depth yet, so I will let you know soon whether the freezing has ceased after some due testing and restarting.

If it does work, I will owe you something big!!

 

[SkipVought]

So you're only observing these timing malfunctions after a GetString()?

BTW, have you set a reference in the VBE for Excel, to the AttachmateExtra Object Library? Tools > References...

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Hi Skip,

Tested it for a while and excel is still freezing.

Well it isn't just after a GetString(), but usually after some time that the macro has been interacting with Mainframe. It seems that mainframe falls behind, so therefore I have to introduce a sleep to slow it down. It just seems that implementing a miniscule sleep pause after a GetString() allows excel and Mainframe to sync back again.

Yes I have added the object library to the list of references.

Sorry to use up so much of your time on this issue.

 

[SkipVought]

20 years ago I used a wait technique that seemed to work.

12 years ago I changed employers and when I used the same wait technique, I had problems. So I changed to using the .WaitForCursor at the Screen Rest Coordinates.

You may need to experiment. Check Atachmate HELP for every .Wait function to determine how each may function and to understand the potential pros and cons of each. Set up a test to read a value from Excel, put the value on a screen, send it off the the mainframe, .Wait for the response and write a value back to Excel.
You can also record the time at the beginning/end of each row. So you have values and time as objective data to evaluate each .Wait test.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Vik12]

Hi Skip,

I will be experimenting for quite a bit of time since I am very new to VBA. I will try your suggestions in order to break it down slowly and find the issue. Thank you so much for your help and advice Skip, I really do appreciate it!

 

[SkipVought]

Let me clarify. In order to design an adequate test you really need a list of values to read/send/receive/write. Good luck! Post back with questions, status and conclusions.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]