Home > database >  Macro runs perfectly on my PC but gives error when I run it on any other PC
Macro runs perfectly on my PC but gives error when I run it on any other PC

Time:02-12

I have a code that requests a certain piece of information from a website. The issue is that it works absolutely perfectly on my PC, but when I send the file to another PC and run the code, I get the following error:

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

I have already ensured that:

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

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

It has been 2 days of extensive searching the internet and still haven't found the root cause of this issue.

Code:

    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

CodePudding user response:

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
  • Related