Мой скрипт выдает ошибку при циклическом переходе по ссылкам - PullRequest
Новая
       26

Мой скрипт выдает ошибку при циклическом переходе по ссылкам

0 голосов
/ 06 июля 2018

Я написал скрипт в vba в сочетании с IE, чтобы выполнять клики на некоторых ссылках javascript, связанных с каждым профилем веб-страницы. Мой сценарий может без проблем щелкнуть первую ссылку, но когда он нажимает на следующую ссылку во второй итерации, он выдает ошибку permission denied. На каждом профиле есть действительные ссылки, поэтому я не могу использовать ссылки для навигации. Как я могу изменить свой скрипт, чтобы циклически переходить по ссылкам?

Это мой сценарий: 

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

1 Ответ

0 голосов
/ 06 июля 2018

Использование XHR-запроса. Далее выполняется первоначальный запрос GET для получения всех идентификаторов персонала. Затем он зацикливает идентификаторы, выдавая POST запросов для каждого идентификатора. Чтобы показать, что он посещает каждую страницу, я извлекаю адрес электронной почты персонала с каждой страницы. 

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

Пример распечатки кода со страницы:

enter image description here

Неуклюжие, основанные на ожидании обновления, а затем переход обратно на целевую страницу, чтобы можно было отправить следующую форму Это нуждается в улучшении и некотором переупорядочении. 

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
...