Search code examples
vbaexcelweb-scrapinginternet-explorer-11

My script throws error while clicking on links cyclically


I've written a script in vba in combination with IE to perform clicks on some javascript links connected to each profile of a webpage. My script can click on the first link flawlessly but when it comes to click on the next link in it's second iteration, it throws permission denied error. There are on valid links connected to each profile so I can't use the links as navigation. How can I modify my script in order to click on links cyclically?

This is my script:

Sub ClickLinks()
    Const Url As String = "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=dirmain&type=FAC&display=basic"
    Dim IE As New InternetExplorer, Htmldoc As HTMLDocument, I&

    With IE
        .Visible = True
        .navigate Url
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set Htmldoc = .document
    End With

    With Htmldoc.querySelectorAll("#main table tr a")
        For I = 0 To .Length - 1
            .Item(I).Click  'in second iteration this line throws permission denied error
            Application.Wait Now + TimeValue("00:00:03")
        Next I
    End With
End Sub

Solution

  • Using an XHR request. The following does an initial GET request to retrieve all the staff IDs. It then loops the ids issuing POST requests for each id. To show it visits each page, I retrieve the staff e-mail address from each page.

    Option Explicit
    Public Sub GetInfo()
        Dim objHTTP As Object, URL As String, html As New HTMLDocument, i As Long, sBody As String
        Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
        URL = "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=details"
    
        With objHTTP
            .Open "GET", "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=dirmain&type=FAC&display=basic", False
            .send
            html.body.innerHTML = .responseText
            Dim staffIDs As Object
            Set staffIDs = html.querySelectorAll("input[name=employeeID]")
    
            For i = 0 To staffIDs.Length - 1
                sBody = "employeeID=" & staffIDs(i).getAttribute("value")
                .SetTimeouts 10000, 10000, 10000, 10000
                .Open "POST", URL, False
                .setRequestHeader "User-Agent", "User-Agent: Mozilla/5.0 (Windows NT 6.3; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/66.0.3359.181 Safari/537.36"
                .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
                On Error Resume Next
                .send (sBody)
                If Err.Number = 0 Then
                    If .Status = "200" Then
                        html.body.innerHTML = .responseText
                    Else
                        Debug.Print "HTTP " & .Status & " " & .statusText
                        Exit Sub
                    End If
                Else
                    Debug.Print "Error " & Err.Number & " " & Err.Source & " " & Err.Description
                    Exit Sub
                End If
                On Error GoTo 0
                Debug.Print html.querySelector("td a").innerText
            Next i
        End With
    End Sub
    

    Sample view on landing page:

    sample view


    Sample code printout from page:

    enter image description here


    Clunky time based wait for refresh and then navigation back to landing page so can submit next form. This needs improvement and some re-ordering.

    Option Explicit
    Public Sub ClickLinks2()
        Const URL As String = "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=dirmain&type=FAC&display=basic"
        Dim IE As New InternetExplorer, Htmldoc As HTMLDocument, i&
    
        With IE
            .Visible = True
            .navigate URL
            While .Busy = True Or .readyState < 4: DoEvents: Wend
            Set Htmldoc = .document
    
            Dim numEmployees As Long, a As Object
            numEmployees = Htmldoc.querySelectorAll("a.names").Length
    
            For i = 1 To 3                           'numEmployees   (1-792)
                While .Busy = True Or .readyState < 4: DoEvents: Wend
                .navigate URL
                Application.Wait Now + TimeSerial(0, 0, 5)
                .document.parentWindow.execScript "document.form" & i & ".submit();" ''javascript:document.form1.submit(); ''<== Adapted this
            Next i
        End With
    End Sub