CODEWITHSUNDEEP
vbaexcelweb-scrapinginternet-explorer-11
SIM
SIM

Reputation: 22440

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

Upvotes: 0

Views: 53

Answers (1)

QHarr
QHarr

Reputation: 84465

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

Upvotes: 1

Related Questions