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

问题

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

回答1:

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

来源：https://stackoverflow.com/questions/61578926/excel-vba-web-scraping-returning-wrong-text-in-msxml2-xmlhttp-method