(Solved) – Object variable or with block variable not set error in vba while web scraping error


Referring to question on stack overflow

Search a website using excel vba with excel data and extract the active state in flowchart of search result and mapping it into column

Code is running fine when access codes are valid, with invalid codes in columnD it breaks the code giving error instead of going to the next code if any invalid code comes in. Any help would be incredible!

Here is my code:

Option Explicit

Public Sub GetStatus()

    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("Guy Touti")
    senhas = Application.Transpose(ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row))

    ReDim results(1 To UBound(senhas))

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

    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")
On Error GoTo x
            classinfo = Split(nodes(nodes.Length - 1).className, Chr$(32))
            results(i) = Replace$(classinfo(1), "step", vbNullString) & "-" & colourLkup(classinfo(2))
        End If
        Set nodes = Nothing
    ws.Cells(2, 5).Resize(UBound(results), 1) = Application.Transpose(results)
End Sub

Sub CopyCommentText()

Dim ws As Worksheet
Set ws = ActiveSheet
ws.Cells.Replace what:=Chr(10), replacement:=""
ws.Cells.Replace what:=" ", replacement:=""
Set ws = Nothing
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *