获取一个网站从列表数据到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财产的一部分。我注意到动态提供的数据通常会出现这种情况，而且这种方法对于大多数网络抓取来说太简单了。

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

我认为你可以得到它的返回<DIV>标签的集合，然后检查那些类名与环内的If statment。

我做了一些修改，以我原来的答复，这应该打印每条记录在一个新的小区：

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