从实时网站提取数据

时间:2018-06-08 03:26:34

标签: vba

我使用VBA从网站中提取数据以获取excel有点新鲜,我想知道你们是否可以帮助我从网站中提取数据以使用vba进行excel然后让它每小时运行一次?

我可以使用代码来教育自己

基本上,我想访问以下网站

然后只需将所有道路的行程时间复制粘贴到Excel中即可。这包括电流,理想和延迟。

是否可以这样做?

2 个答案:

答案 0 :(得分:1)

您需要在VBA库中添加两个引用来运行此代码 要添加所需的参考文献:(VBE>工具>参考文献)

  

Microsoft HTML对象库& Microsft Internet Controls

运行之后,您会注意到需要Split字符串输出来隔离您想要的各个变量(当前,理想,延迟),然后您需要系统地将这些变量分配给表在你的excel中。

您应该对网络抓取进行一些研究,以充分了解正在发生的事情。如果您导航到页面>右键单击路线>检查元素>你会看到下面的代码是从标签" tr"中拉出来的。 ("tr")(3)将与网站上详述的第3条路线相对应。

Sub MainSub()
Dim IE As InternetExplorer
Set IE = New InternetExplorer

IE.Navigate "https://www.cp24.com/mobile/commuter-centre/traffic"

Do
    DoEvents
Loop Until IE.ReadyState = ReadyState_Complete

Dim Doc As HTMLDocument
Set Doc = IE.Document

Dim FirstRoute As String
Dim SecondRoute As String

FirstRoute = Trim(Doc.getElementsByTagName("tr")(1).innerText)
SecondRoute = Trim(Doc.getElementsByTagName("tr")(2).innerText)

MsgBox FirstRoute & vbNewLine & vbNewLine & vbNewLine & SecondRoute

IE.Quit
Set IE = Nothing
End Sub

答案 1 :(得分:0)

这应该做您想要的!

Option Explicit
Sub Web_Table_Option_One()
    Dim xml    As Object
    Dim html   As Object
    Dim objTable As Object
    Dim result As String
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
    With xml
        .Open "GET", "https://www.cp24.com/mobile/commuter-centre/traffic", False
        .send
    End With
    result = xml.responseText
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = result
    Set objTable = html.getElementsByTagName("Table")
    For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable
End Sub

设置适当的引用...

enter image description here