MSXML2.XMLHTTP可以检索给定网页的所有HTML数据吗?

时间:2018-08-06 14:40:58

标签: html vba ms-access web-scraping

使用显示检索数据表的动态网页,我发现MSXML2.XMLHTTP和Internet Explorer对象通常都无法访问此数据。 https://www.tiff.net/tiff/films.html是一个很好的例子。两种技术都不会检索任何电影数据,而只会检索周围的网页。我尝试过的代码如下:

Function getHTTP(ByVal sReq As String) As Variant
    On Error GoTo onErr
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sReq, False
        .send
        getHTTP = StrConv(.responseBody, 64)
    End With
    Exit Function
    onErr:   MsgBox "Error " & Err & ": " & Err.Description, 49, "Error opening site"
End Function

Function GetHTML(ByVal strURL As String) As Variant
  Dim oIE As InternetExplorer
  Dim hElm As IHTMLElement
  Set oIE = New InternetExplorer
  oIE.Navigate strURL
  Do While (oIE.Busy Or oIE.ReadyState <> READYSTATE_COMPLETE)
     DoEvents
  Loop
  Set hElm = oIE.Document.all.tags("html").Item(0)
  GetHTML = hElm.outerHTML
  Set oIE = Nothing
  Set hElm = Nothing
End Function

但是有一种方法可以手动检索电影数据-只需使用Microsoft Edge或Internet Explorer遵循以下步骤:

Right-click on one of the movies 

Choose “inspect element." The DevTools console opens. 

At the bottom-left of the screen, click on the “html” tab. 

Right-click the tab.  Choose “copy.” 

Open notepad and paste what you’ve copied.

您现在拥有影片数据,可以将其保存到文件中进行解析。我的问题:有什么办法以编程方式获取此数据?

2 个答案:

答案 0 :(得分:1)

以下是使用IE的电影标题(您可以使用相同的过程获取导演)

Option Explicit
Public Sub GetFilms()
    Dim IE As New InternetExplorer, html As HTMLDocument, films As Object, i As Long
    With IE
        .Visible = True
        .navigate "https://www.tiff.net/tiff/films.html"

        While .Busy Or .readyState < 4: DoEvents: Wend
        Set films = .document.querySelectorAll("[target=_self]")

        For i = 0 To films.Length - 1
            Debug.Print films.item(i).innerText
        Next
        .Quit '<== Remember to quit application
    End With
End Sub

使用提供的URL,XHR太快了,但是IE很好。

如果您检查HTML,则可以看到每部电影具有以下共同点:

HTML

a标记内有一个名为target的属性,其值为_self

您可以使用querySelectorAll的{​​{1}}方法使用属性CSS选择器来收集所有这些匹配元素


CSS选择器(示例):

Sample


我想知道是否可以通过解析HTML来解决影片说明的问题。我以为评论的出现掩盖了影片的描述。从理论上document.中选择文本的正则表达式似乎在应用于"<!-- react-text: \d+ -->([^...].+?(?=<))"时会失败,就像试图以正则表达式开始并结束注释一样。

答案 1 :(得分:1)

为什么要使用Json?,因为页面是使用json数据加载的

要查看::使用Google Chrome浏览器->按F12->加载URL->转到网络标签

enter image description here


代码:

Sub getHTTP()

    Dim Url As String, data As String
    Dim xml As Object, JSON As Object, colObj, item


    Url = "https://www.tiff.net/data/films-events-2018.json?q=1513263947586"

    Set xml = CreateObject("MSXML2.ServerXMLHTTP")
    With xml
        .Open "GET", Url, False
        .send
        data = .responseText
    End With


    Set JSON = JsonConverter.ParseJson(data)
    Set colObj = JSON("items")

    For Each item In colObj
        Debug.Print item("title")
        Debug.Print item("description")

        For Each c1 In item("cast")
            Debug.Print c1
        Next

        For Each c2 In item("countries")
            Debug.Print c2
        Next
    Next
End Sub

输出

enter image description here


安装JsonConverter

  1. 下载latest release
  2. 将JsonConverter.bas导入项目(打开VBA编辑器,Alt + F11;文件>导入文件) 添加字典参考/类
  3. 仅适用于Windows,请包含对“ Microsoft脚本运行时”的引用
  4. 对于Windows和Mac,包括VBA-字典

树状数据视图

enter image description here