从网站上的列表中获取数据以 Excel VBA

Question

我正在尝试找到一种从 yelp.com 获取数据的方法

我有一个电子表格，上面有几个关键字和位置。我希望根据电子表格中已有的这些关键字和位置从 yelp 列表中提取数据。

我创建了以下代码，但它似乎得到了荒谬的数据，而不是我正在寻找的确切信息。

我想获得公司名称、地址和电话号码，但我什么都没有。如果这里有人可以帮我解决这个问题。

Sub find()

Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        ie.Visible = False
        ie.Navigate "http://www.yelp.com/search?find_desc=boutique&find_loc=New+York%2C+NY&ns=1&ls=3387133dfc25cc99#start=10"
        ' Don't show window
    ie.Visible = False

    'Wait until IE is done loading page
    Do While ie.Busy
        Application.StatusBar = "Downloading information, lease wait..."
        DoEvents
    Loop

    ' Make a string from IE content
    Set mDoc = ie.Document
    peopleData = mDoc.body.innerText
    ActiveSheet.Cells(1, 1).Value = peopleData
End With

peopleData = "" 'Nothing
Set mDoc = Nothing
End Sub

Answer 1

如果您在 IE 中单击鼠标右键，然后执行 View Source，很明显该站点上提供的数据不是文档的 .Body.innerText 属性的一部分。我注意到动态提供的数据经常出现这种情况，而且这种方法对于大多数网络抓取来说实在是太简单了。

我在谷歌浏览器中打开它并检查元素以了解我真正在寻找什么，以及如何使用 DOM/HTML 解析器找到它；您需要添加对 Microsoft HTML 对象库的引用。

我认为你可以让它返回 <DIV> 标签的集合，然后在循环中使用 If 语句检查这些类名。

我对原来的答案做了一些修改，这应该在一个新的单元格中打印每条记录：

Option Explicit
Private Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub find()
'Uses late binding, or add reference to Microsoft HTML Object Library 
'  and change variable Types to use intellisense
Dim ie As Object 'InternetExplorer.Application
Dim html As Object 'HTMLDocument
Dim Listings As Object 'IHTMLElementCollection
Dim l As Object 'IHTMLElement
Dim r As Long
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .Navigate "http://www.yelp.com/search?find_desc=boutique&find_loc=New+York%2C+NY&ns=1&ls=3387133dfc25cc99#start=10"
        ' Don't show window
        'Wait until IE is done loading page
        Do While .readyState <> 4
            Application.StatusBar = "Downloading information, Please wait..."
            DoEvents
            Sleep 200
        Loop
        Set html = .Document
    End With
    Set Listings = html.getElementsByTagName("LI") ' ## returns the list
    For Each l In Listings
        '## make sure this list item looks like the listings Div Class:
        '   then, build the string to put in your cell
        If InStr(1, l.innerHTML, "media-block clearfix media-block-large main-attributes") > 0 Then
            Range("A1").Offset(r, 0).Value = l.innerText
            r = r + 1
        End If
    Next

Set html = Nothing
Set ie = Nothing
End Sub