Question

我是vba的新手。

我正在尝试使用David Zemens的以下代码从yelp中获取数据

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

问题是它没有从源获取任何数据。

此致

Answer 1

还有很多工作要做。

这是你可以开始的事情。希望您能够使用相同的逻辑找到其他信息。这将在即时窗口中打印业务名称。我在元标记说明中找到了商家名称。

我已将睡眠量改为5秒。 IE将能够完全加载，其余代码将被可靠地处理。最初的200毫秒在每两次运行中给出了一次结果。我想这取决于你的电脑有多快，所以5秒是非常安全的我猜。

Option Explicit

Declare 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 returnstring As String 'this is going to hold boutiques names
Dim ie As Object 'InternetExplorer.Application
Dim html As Object 'HTMLDocument
Dim meta 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 5000
        Loop
        Set html = .Document
    End With
    Set meta = html.GetElementsByTagName("META") ' ## returns attribures
    Dim m As Object

    For Each m In meta
    If InStr(m.Content, "Reviews on Boutique in New York -") > 0 Then
    returnstring = Replace(m.Content, "Reviews on Boutique in New York -", "")
    End If
    Next
    Dim i As Integer
    For i = 0 To UBound(Split(returnstring, ","))
    Debug.Print (Split(returnstring, ",")(i))
    Next
Set html = Nothing
Set ie = Nothing
End Sub

MyOutput中： enter image description here

vba代码正在运行但未获取数据

1 个答案: