'Working code gives error when run on any other PC

I have working code that requests information from a website.

When I send the file to another PC and run the code, I get:

"Run-time error'91': Object variable or With block variable not set"

I ensured:

  1. Macro security levels are the same (Enable all macros & trust access to VBA project object model)

  2. All the checked boxes in VBA editor > Tools > References are the same (Specifically Microsoft HTML Object Library & Microsoft XML, V6.0 is checked)

Sub Macro1()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim Current As Variant

website = "https://www.thalia.de/shop/home/artikeldetails/A1062020980"
Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "GET", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send
response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response

Current = html.getElementsByClassName("element-text-standard value").Item(0).innerText
MsgBox (Current)
End Sub

The line on which I get the error:

Current = html.getElementsByClassName("element-text-standard value").Item(0).innerText


Solution 1:[1]

WinHttp

  • I've tried a ton of various solutions, in the end, it came just to replacing MSXML2.XMLHTTP with WinHttp.WinHttpRequest.5.1 to make it work on my computer. While I was researching, I rewrote the whole thing a little bit. I'm a noob at this so I can't explain why one works and the other does not.
Option Explicit


Sub Macro1()
    
    Const URL As String _
        = "https://www.thalia.de/shop/home/artikeldetails/A1062020980"
    'Const URL As String _
        = "https://www.thalia.de/shop/home/artikeldetails/A1060523771"
    
    Const ClassName As String _
        = "element-text-standard value"
    
    Dim WhrResponseText As String
    WhrResponseText = GetWhrResponseText(URL)
    If Len(WhrResponseText) = 0 Then
        MsgBox "Could not get a response.", vbExclamation
        Exit Sub
    End If

'    ' Write the response string to a worksheet.
'    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
'    Dim arr() As String: arr = Split(WhrResponseText, vbLf)
'    ws.Range("A1").Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
    
    Dim Elements As Object
    With CreateObject("htmlfile")
        .body.innerHTML = WhrResponseText
        Set Elements = .getElementsByClassName(ClassName)
    End With
    
    ' Using 'Length' to determine if a result was found and returning
    ' the first element.
    Dim Result As Variant
    With Elements
        If .Length > 0 Then
            Result = .Item(0).innerText
            MsgBox Result
        Else
            MsgBox "Nothing found."
        End If
    End With
        
    Dim i As Long
    
    ' Loop through the elements using 'For Each... Next'.
    Dim Element As Object
    For Each Element In Elements
        Debug.Print i, Element.innerText
        i = i + 1
    Next Element
    
'    ' Loop through the elements using 'For... Next'.
'    With Elements
'        For i = 0 To .Length - 1
'            Debug.Print i, .Item(i).innerText
'        Next i
'    End With

End Sub


Function GetWhrResponseText( _
    ByVal URL As String) _
As String
    Const ProcName As String = "GetWhrResponseText"
    On Error GoTo ClearError

    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", URL, False
        .send
        GetWhrResponseText = StrConv(.responseBody, vbUnicode)
    End With

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1