导致excel停止响应的VBA脚本

Question

我有从excel运行的以下vba代码，它与另一个程序完美地交互。

' 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 

然而，一次完成后的问题，在大约10-15秒后完美无缺，excel冻结并需要手动关闭。这有什么理由吗？根据我的研究，我将变量和对象设置为空，但这仍然无济于事。

谢谢！