Проблемы с повторным использованием того же Http после передачи его из подпрограммы в функцию - PullRequest
Новая
       74

Проблемы с повторным использованием того же Http после передачи его из подпрограммы в функцию

0 голосов
/ 08 мая 2020

Я написал сценарий, использующий xhr, чтобы проанализировать ссылку на первое сообщение с этого веб-сайта , а затем передал link и http функции для извлечения заголовка из его внутренней страница. Важно, чтобы я передал функции link и http, чтобы использовать их повторно. .

Кажется, мой сценарий работает в правильно, но я не уверен, что все сделал правильно. Причина моего замешательства в том, что я получаю результат, когда использую как getHTTP(ByVal Http, ByVal link) As Variant. Я даже получаю результат, когда я go вместо getHTTP(ByVal Http, ByVal link) As String или getHTTP(ByVal Http, ByVal link). Более того, я не определил явно link as String или Http as XMLHTTP60 в параметрах функции.

Я пробовал (работает безупречно): 

Function getHTTP(ByVal Http, ByVal link) As Variant
    Dim Html As New HTMLDocument, oTitle$

    With Http
        .Open "GET", link, False
        .send
        Html.body.innerHTML = .responseText
        oTitle = Html.querySelector("h1[itemprop='name'] > a").innerText
        getHTTP = oTitle
    End With
End Function

Sub GetInfo()
    Const base$ = "https://stackoverflow.com"
    Const Url$ = "https://stackoverflow.com/questions/tagged/web-scraping"
    Dim Http As New XMLHTTP60, Html As New HTMLDocument
    Dim firstLink$, postTitle$

    With Http
        .Open "GET", Url, False
        .send
        Html.body.innerHTML = .responseText
        firstLink = base & Replace(Html.querySelector(".summary .question-hyperlink").getAttribute("href"), "about:", "")
        postTitle = getHTTP(Http, firstLink)
        MsgBox postTitle
    End With
End Sub

Как правильно сделать то же самое, сохранив существующий logi c нетронутым?

1 Ответ

1 голос
/ 08 мая 2020

Что-то вроде этого может быть подходящим: 

Sub GetInfo()

    Const base As String = "https://stackoverflow.com"
    Const url As String = "https://stackoverflow.com/questions/tagged/web-scraping"
    Dim Html As HTMLDocument
    Dim firstLink As String, postTitle As String

    firstLink = base & Replace(GetPage(url).querySelector(".summary .question-hyperlink") _
                .getAttribute("href"), "about:", "")
    Debug.Print firstLink

    postTitle = GetPage(firstLink).querySelector("h1[itemprop='name'] > a").innerText
    Debug.Print postTitle

End Sub

Function GetPage(url As String) As HTMLDocument
    Dim Html As HTMLDocument
    Static Http As XMLHTTP60

    If Http Is Nothing Then
        Set Http = New XMLHTTP60
        'log in here
    End If

    With Http
        .Open "GET", url, False
        .send
        If .Status = 200 Then
            Set Html = New HTMLDocument
            Html.body.innerHTML = .responseText
        Else
            Debug.Print .Status
            'warn user
        End If
    End With
    Set GetPage = Html
End Function

Прежде всего, предполагается «счастливый путь», поэтому, вероятно, будет полезна некоторая обработка исключений ...

...