Excel VBA Web爬网在MSXML2.XMLHTTP方法中返回错误的文本 [英] Excel VBA Web Scraping Returning Wrong Text in MSXML2.XMLHTTP method

问题描述

我正在尝试从此网址提取电影说明，" https://ssl.ofdb.de/plot/138627,271359，I-Am-Legend "

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

当我使用CreateObject("InternetExplorer.Application")方法时，它为我提供了在网站上可见的正确Web字符串(此方法很慢)

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)

但是，如果我使用MSXML2.XMLHTTP，则返回某些文本或不可读的文本(但是此方法很快)

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)

罗伯特·内维尔(威尔·史密斯)(Will Smith)战争发生在维格纳德·维森(Hervorragender Wissenschaftler)，艾伯·奥赫(Aber auch er konnte nicht verhindern)，达斯·艾因(Dars ein)Virus vor 3 Jahren die gesamte Menschheit befiel.Nur er wurde aus unbekanntenGründenverschont und hat es sich inzwischen in einer immer mehr verwahrlosenden Umgebung eingerichtet.贝德罗洪(Bedrohung)医院和医疗中心...

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...

第二种方法的输出:

罗伯特·内维尔(威尔·史密斯)(Will Smith)战争发生在维格纳德·维森(Hervorragender Wissenschaftler)，艾伯·奥赫(Aber auch er konnte nicht verhindern)，达斯·艾因(Dars ein)Virus vor 3 Jahren die gesamte Menschheit befiel.Nur er wurde aus unbekanntenGründenverschont und hat es sich inzwischen in einer immer mehr verwahrlosenden Umgebung eingerichtet.坎恩贝德罗洪(Bedrohung)的病史和精神病史...

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...

您看到第二种方法中存在一些unicode文本.

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

推荐答案

您想从返回的字节字符串(而不是unicode)中获取UTF-8.您可以使用如下所示的帮助程序功能，这些功能来自我

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

---

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

这篇关于Excel VBA Web爬网在MSXML2.XMLHTTP方法中返回错误的文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！