vbaloopsreadystate

Is there a better way to accomplish this loop?


I'm pretty new with VBA, but I've been muddling through to make a program for my team. This piece of code works most of the time, but tends to hang on occasion. I can't figure out why it would hang sometimes, and work perfectly most of the time, so I'm now trying to figure out a better way to accomplish this loop. I know that this method of looping isn't the best way to do things, but not sure how to accomplish the task.

My webpage operates in a PEGA Web application, and the native IE ready state indicators are always 'ready' so I have to use the web application's ready state markers.

Can anyone help me out?

Public Sub WaitingForRS()
' FIND THE C360 WINDOW
        Marker = 0
        Set objShell = CreateObject("Shell.Application")
        IE_count = objShell.Windows.Count
        For x = 0 To (IE_count - 1)
            On Error Resume Next
            my_url = objShell.Windows(x).Document.Location
            my_title = objShell.Windows(x).Document.title

            If my_title Like "Coverage User" & "*" Then
                Set C360Window = objShell.Windows(x)
                Marker = 1
                Exit For
            Else
            End If
        Next

        If Marker = 0 Then
            MsgBox ("C360 window is not found. Please ensure C360 is open in Internet Explorer and try again")
        Else
        End If

'FIND THE READY STATE INDICATOR
    RSIndicatorDocMarker = 0
    RSIndicatorDataMarker = 0
    Set RSIndicatorPage = C360Window.Document
    Set RSIndicatorClass = RSIndicatorPage.getelementsbyclassname("document-statetracker")(0)

RSIndicatorCheck:
'CHECK THE READY STATE DOC STATUS
    If RSIndicatorClass.getattribute("data-state-doc-status") = "ready" Then
        RSIndicatorDocMarker = 1
        Else: RSIndicatorDocMarker = 0
    End If

'CHECK THE READY STATE
    If RSIndicatorClass.getattribute("data-state-busy-status") = "none" Then
        RSIndicatorDataMarker = 1
        Else: RSIndicatorDataMarker = 0
    End If

'Compare the RSIndicators
    If RSIndicatorDataMarker = 1 And RSIndicatorDocMarker = 1 Then

    Else: GoTo RSIndicatorCheck
    End If
End Sub

Solution

  • Maybe try using OnTime instead of the tight loop you currently have:

    Public Sub WaitingForRS()
    
        Dim win As Object
        Dim w As Object, el, ready As Boolean, idle As Boolean
    
        For Each w In CreateObject("Shell.Application").Windows
            If w.Name Like "*Internet*" Then
                If w.Title Like "Coverage user*" Then
                    Set win = w
                    Exit For
                End If
            End If
        Next
    
        If Not win Is Nothing Then
    
            Set el = win.document.getelementsbyclassname("document-statetracker")(0)
            ready = (el.getattribute("data-state-doc-status") = "ready")
            idle = (el.getattribute("data-state-busy-status") = "none")
    
            If ready And idle Then
                ProceedWithNextSteps win 'do whatever comes next: pass in the window
            Else
                'wait for a while then try again
                Application.OnTime Now + TimeSerial(0, 0, 1), "WaitingForRS"
            End If
    
        Else
            MsgBox "Window not found!"
        End If
    
    End Sub
    

    Might want to add a time limit so it doesn't keep looping forever if the page isn't "ready".