'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:
Macro security levels are the same (Enable all macros & trust access to VBA project object model)
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
withWinHttp.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 |