用于从网站获取数据的vba代码

时间:2014-02-13 10:43:16

标签: excel-vba web web-scraping vba excel

我是这个网站的新手,也是VBA编程的新手。我遇到了一个需要从this page获取数据的问题。我需要有Check Rates 10按钮的超链接网址。任何人都可以帮我解决这个问题。

我已完成以下代码:

Sub GetData()

Dim IE As New InternetExplorer
IE.navigate "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345"
IE.Visible = False

Do
    DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Dim doc As HTMLDocument 'variable for document or data which need to be extracted out of webpage
Set doc = IE.document
Dim dd As Variant
dd = doc.getElementsByClassName("lgn")(0).outerHtml
'Range("a1").Value = dd
MsgBox dd

End Sub

我在其中获取按钮的文本,但我想拥有该类的值。我认为我非常接近结果,但不知何故达不到目标......任何人都可以帮助我......

此致

2 个答案:

答案 0 :(得分:0)

我认为这就是你要找的东西:

(代码略微改编自Kyle的回答here

Sub Test()
'Must have the Microsoft HTML Object Library reference enabled
Dim oHtml As HTMLDocument
Dim oElement As Object
Dim link As String

Set oHtml = New HTMLDocument

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345", False
    .Send
    oHtml.Body.innerHTML = .responseText
End With

If InStr(1, oHtml.getElementsByClassName("lgn")(0).innerText, "Bekijk 10 prijzen") > 0 Then
    link = Mid(oHtml.getElementsByClassName("lgn")(0).href, 7)
    Debug.Print "http://www.kieskeurig.nl" & link
End If

End Sub

此代码将URL打印到即时窗口。希望有所帮助!

答案 1 :(得分:0)

这对我有用......

Sub GetData()
    Set IE = CreateObject("InternetExplorer.Application")
    my_url = "http://www.kieskeurig.nl/zoeken/index.html?q=4960999543345"

    With IE
        .Visible = True
        .navigate my_url
        .Top = 50
        .Left = 530
        .Height = 400
        .Width = 400

    Do Until Not IE.Busy And IE.readyState = 4
        DoEvents
    Loop

    End With

    Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading

    Set Results = IE.document.getElementsByTagName("a")
    For Each itm In Results
        If itm.classname = "lgn" Then
            dd = itm.getAttribute("href")
            Exit For
        End If
    Next

' if you wnat to click the link
    itm.Click

' otherwise
    'Range("a1").Value = dd
    MsgBox dd
End Sub