Excel VBA Web Scraping Returning Wrong Text in MSXML2.XMLHTTP method

Question

I am trying to extract the movie description from this Url, "https://ssl.ofdb.de/plot/138627,271359,I-Am-Legend"

When i use CreateObject("InternetExplorer.Application") method it gives me the correct web string as visually seen in the web site (This method is slow)

But if i use the MSXML2.XMLHTTP,some of the text returned or non readable text (But this method is fast)

Output of First Method:(No problem)

Robert Neville (Will Smith) war ein hervorragender Wissenschaftler, aber auch er konnte nicht verhindern, dass ein Virus vor 3 Jahren die gesamte Menschheit befiel. Nur er wurde aus unbekannten Gründen verschont und hat es sich inzwischen in einer immer mehr verwahrlosenden Umgebung eingerichtet.Tagsüber kann er sich verhältnismässig frei bewegen, aber nachts lauern überall Gefahren durch vampirähnliche infizierte Gestalten, die nur das Sonnenlicht fern halten kann. Doch die Bedrohung wächst ständig und er versucht ein Gegenserum zu entwickeln...

Output of Second Method:

Robert Neville (Will Smith) war ein hervorragender Wissenschaftler, aber auch er konnte nicht verhindern, dass ein Virus vor 3 Jahren die gesamte Menschheit befiel. Nur er wurde aus unbekannten GrÃ¼nden verschont und hat es sich inzwischen in einer immer mehr verwahrlosenden Umgebung eingerichtet.TagsÃ¼ber kann er sich verhÃ¤ltnismÃ¤ssig frei bewegen, aber nachts lauern Ã¼berall Gefahren durch vampirÃ¤hnliche infizierte Gestalten, die nur das Sonnenlicht fern halten kann. Doch die Bedrohung wÃ¤chst stÃ¤ndig und er versucht ein Gegenserum zu entwickeln...

As you see some unicode texts are present in the second method.

Here i am attaching the second method codes,any ideas how to get the same text as seen in the web site?

Link_3 = "https://ssl.ofdb.de/plot/138627,271359,I-Am-Legend"

    'required VBE (Alt+F11) > Tools > References > Microsoft HTML Object Library

    Set xhr = New MSXML2.XMLHTTP60
    Set html = New MSHTML.HTMLDocument

    With xhr
        .Open "GET", Link_3, False
        .setRequestHeader "Content-Type", "text/html; charset=none"
        .send
         html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

Dim sana As String
sana = html.getElementsByClassName("Blocksatz")(0).getElementsByTagName("font")(0).getElementsByTagName("b")(0).innerText
ActiveSheet.Cells(1, 4).Value = Application.WorksheetFunction.Clean(Trim(Application.WorksheetFunction.Substitute(html.getElementsByClassName("Blocksatz")(0).getElementsByTagName("font")(0).innerText, sana, ""))) 
Set xhr = Nothing
 Set html = Nothing

QHarr · Accepted Answer · 2020-07-01 20:17:03Z

You want to attain UTF-8 from byte string returned rather than unicode. You can use helper functions as shown below which I have taken from here. This is the 64 bit version. I will leave the 32 bit at the bottom. You can also use a more targeted css selector to obtain your node; this will be quicker and avoid additional string cleaning function calls.

Option Explicit


''' Maps a character string to a UTF-16 (wide character) string
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cchMultiByte As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long _
    ) As Long
' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001

''' Return length of byte array or zero if uninitialized
Private Function BytesLength(abBytes() As Byte) As Long
    ' Trap error if array is uninitialized
    On Error Resume Next
    BytesLength = UBound(abBytes) - LBound(abBytes) + 1
End Function

''' Return VBA "Unicode" string from byte array encoded in UTF-8
Public Function Utf8BytesToString(abUtf8Array() As Byte) As String
    Dim nBytes As Long
    Dim nChars As Long
    Dim strOut As String
    Utf8BytesToString = ""
    ' Catch uninitialized input array
    nBytes = BytesLength(abUtf8Array)
    If nBytes <= 0 Then Exit Function
    ' Get number of characters in output string
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&)
    ' Dimension output buffer to receive string
    strOut = String(nChars, 0)
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars)
    Utf8BytesToString = Left$(strOut, nChars)
End Function

Public Sub test()

    Dim xhr As MSXML2.XMLHTTP60: Set xhr = New MSXML2.XMLHTTP60
    Dim html As MSHTML.HTMLDocument: Set html = New MSHTML.HTMLDocument

    With xhr
        .Open "GET", "https://ssl.ofdb.de/plot/138627,271359,I-Am-Legend", False
        .send
         html.body.innerHTML = Utf8BytesToString(.responseBody)
    End With

    [A1] = html.querySelector("p.Blocksatz").innerText
 
End Sub

32-bit:

Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cchMultiByte As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long _
    ) As Long

Collectives™ on Stack Overflow

Excel VBA Web Scraping Returning Wrong Text in MSXML2.XMLHTTP method

1 Answer 1

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related