Импортировать заголовок из одного места в другое - PullRequest
1 голос
/ 22 июня 2019

Я создал скрипт vba для анализа title различных сообщений вместе с editing status этих сообщений с веб-сайта. Теперь я хочу, чтобы мой сценарий анализировал title со своей целевой страницы, но печатал title одновременно с печатью editing status. Я не хочу создавать две подводные лодки для этой задачи. Я даже не знаю, возможно ли это в vba. Однако, если что-то неясно, проверьте комментарий в моем сценарии.

Sub ImportTitleFromAnotherLocation()
    Const LINK$ = "https://stackoverflow.com/questions/tagged/web-scraping"
    Const prefix$ = "https://stackoverflow.com"
    Dim Http As New XMLHTTP60, Html As New HTMLDocument
    Dim editInfo As Object, I&, targetUrl$, postTile$

    With Http
        .Open "GET", LINK, False
        .send
        Html.body.innerHTML = .responseText
    End With

    With Html.querySelectorAll(".summary .question-hyperlink")
        For I = 0 To .Length - 1

            postTitle = .item(I).innerText 'I like this line to be transferred to the location below

            targetUrl = Replace(.item(I).getAttribute("href"), "about:", prefix)
            With Http
                .Open "GET", targetUrl, False
                .send
                Html.body.innerHTML = .responseText
            End With

            R = R + 1: Cells(R, 1) = postTitle 'here I wish to use the above line like this

            Set editInfo = Html.querySelector(".user-action-time > a")
            If Not editInfo Is Nothing Then
                Cells(R, 2) = editInfo.innerText
            End If
        Next I
    End With
End Sub

1 Ответ

1 голос
/ 22 июня 2019

Вы перезаписываете свой HTML-документ в цикле.Простой способ - использовать вторую переменную htmldocument.Более подробным способом было бы сохранить заголовки перед циклом, например, в массиве во время дополнительного цикла, а затем использовать вашу переменную i для индексации в ней, чтобы получить каждый заголовок во время существующего цикла.

Sub ImportTitleFromAnotherLocation()
    Const LINK$ = "https://stackoverflow.com/questions/tagged/web-scraping"
    Const prefix$ = "https://stackoverflow.com"
    Dim Http As New XMLHTTP60, Html As New HTMLDocument, Html2 As New HTMLDocument

    Dim editInfo As Object, I&, targetUrl$, postTile$
    Dim postTitle As String, r As Long
    With Http
        .Open "GET", LINK, False
        .send
        Html.body.innerHTML = .responseText
    End With

    With Html.querySelectorAll(".summary .question-hyperlink")
        For I = 0 To .Length - 1
            postTitle = .item(I).innerText 'I like this line to be transferred to the location below
            targetUrl = Replace$(.item(I).getAttribute("href"), "about:", prefix)

            With Http
                .Open "GET", targetUrl, False
                .send
                Html2.body.innerHTML = .responseText
            End With

            r = r + 1: ActiveSheet.Cells(r, 1) = postTitle 'here I wish to use the above line like this

            Set editInfo = Html2.querySelector(".user-action-time > a")
            If Not editInfo Is Nothing Then
                ActiveSheet.Cells(r, 2) = editInfo.innerText
            End If
        Next I
    End With
End Sub
...