Есть ли способ получить указанные c данные из html Respose текста, используя Excel VBA

Question

Я не могу сделать это вручную, поэтому разрабатывал VBA для него; мой код VBA работает для поля состояния для сбора данных с веб-сайта, как показано на снимке. Я могу получить данные о состоянии, но не могу извлечь этот адрес / местоположение, выделенное желтым цветом на снимке. Его необходимо добавить в колонку «E» на веб-сайте для каждого индивидуального кода доступа (пароля). Я прилагаю токовый выход. Я новичок в соскобе. Вот изображение поля адреса / местоположения, которое мне нужно в столбце E. (Коды доступа в столбце C)

Вот мой Код VBA:

Option Explicit

Public Sub GetStatus()

On Error GoTo ErrHandler
    Dim html As MSHTML.HTMLDocument, xhr As Object, colourLkup As Object
    Dim ws As Worksheet, senhas(), i As Long, results()

Call CopyCommentText
    Set ws = ThisWorkbook.Worksheets("Client")
    senhas = Application.Transpose(ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row))

    ReDim results(1 To UBound(senhas))

    Set colourLkup = CreateObject("Scripting.Dictionary")
    colourLkup.Add "active1", "green"
    colourLkup.Add "active3", "orange"
    colourLkup.Add "valid", "valid"

    Set html = New MSHTML.HTMLDocument
    Set xhr = CreateObject("MSXML2.XMLHTTP")

    For i = LBound(senhas) To UBound(senhas)
        If senhas(i) <> vbNullString Then
            With xhr
                .Open "POST", "https://nacionalidade.justica.gov.pt/Home/GetEstadoProcessoAjax", False
                .setRequestHeader "User-Agent", "Mozilla/5.0"
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
                .send "SenhaAcesso=" & senhas(i)
                html.body.innerHTML = .responseText
            End With

            Dim nodes As Object, classinfo() As String

            Set nodes = html.querySelectorAll(".active1, .active3")

            classinfo = Split(nodes(nodes.Length - 1).className, Chr$(32))
            results(i) = Replace$(classinfo(1), "step", vbNullString) & "-" & colourLkup(classinfo(2))

 End If
        Set nodes = Nothing
    Next
    ws.Cells(2, 4).Resize(UBound(results), 1) = Application.Transpose(results)

ErrHandler:

'Error No. 1004 occurs in this case if worksheet with the same name already exists

If Err = 91 Then

'MsgBox "Invalid Code" & Chr(10) & Sheet1.Cells(i + 568, 4).Value & " " & "Row" & i + 568
classinfo(1) = "Invalid"
classinfo(2) = "Valid"


Resume Next
End If

Call CopyCommentText

Call Copy_With_AutoFilter1

End Sub

Вот вывод, который я сделал, чтобы коды доступа были скрыты, поскольку это конфиденциально.

Здесь это текст ответа, который я использую для отладки print

Answer 1

Попробуйте следующее, чтобы получить адрес:

Public Sub GetAddress()
    Const pUrl$ = "https://nacionalidade.justica.gov.pt/Home/GetEstadoProcessoAjax"
    Dim Html As New HTMLDocument, Xhr As New XMLHTTP60
    Dim address$

    With Xhr
        .Open "POST", pUrl, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send "SenhaAcesso=0908-1378-1843"
        Html.body.innerHTML = .responseText
    End With

    address = Html.querySelector("#block_container + div[style*='bold']").innerText

    MsgBox address
End Sub