Excel VBA Web Scraping在MSXML2.XMLHTTP方法中返回错误的文本

Question

我正在尝试从此 URL 中提取电影描述， "https://ssl.ofdb.de/plot/138627,271359,I-Am-Legend"

当我使用 CreateObject("InternetExplorer.Application") 方法时，它会为我提供正确的 Web 字符串，就像在网站上直观地看到的那样（这种方法很慢）

但是如果我使用MSXML2.XMLHTTP，一些返回的文本或者不可读的文本（但是这个方法很快）

第一种方法的输出：（没问题）

罗伯特·内维尔 (Will Smith) 的战争是在她的战争中，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 mehr verwahrlosenden Umgebung eingerichtet。 Doch die Bedrohung wächst ständig under er versucht ein Gegensenrum zu entwickeln...

第二种方法的输出：

罗伯特·内维尔 (Will Smith) 的战争是在她的战争中，Wissenschaftler, aber auch er konnte nicht verhindern, dass ein Virus vor 3 Jahren die gesamte Menschheit befiel。 nur er ruude aus unbekanntengrändenverschont und haver in inzwischen在Einer inmer mehr verwahrlosenden umgebungeingingtichtet.tagsöltnismãanannsssigfrei begen，aber nachts lauernÃberallgefahrendurchirèhnlicheinfizierte gestalte gestalte gestalten，Die Nur Das Sonnenlicht Fern Halten坎恩Doch die Bedrohung wächst ständig under versucht ein Gegensrum zu entwickeln...

如您所见，第二种方法中存在一些 unicode 文本。

我在这里附上第二种方法代码，有什么想法可以得到与网站上看到的相同的文本吗？

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

Answer 1

您希望从返回的字节字符串而不是 unicode 中获得 UTF-8。您可以使用我从here 获取的帮助函数，如下所示。这是 64 位版本。我将把 32 位留在底部。你也可以使用更有针对性的css选择器来获取你的节点；这会更快并且避免额外的字符串清理函数调用。

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 位：

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