vba获取带有内部文本的href

时间:2018-12-07 15:55:57

标签: loops web-scraping html-table innerhtml

我希望从2012年开始更新旧脚本。它曾经将表数据从该目录中提取并放入电子表格中。我对VBA感到生锈

我无法实现的是在线表格Excel中的组织表格。在传输过程中,我将目标指向蓝色DETAIL按钮上的链接,因为该链接的cID =,然后我们将在这些页面上循环以获取有关另一个下标的更多信息(因为我不够先进,无法一次完成所有操作,想要对服务器征税):

javascript:CompanyDetails('http://www.loadmatch.com/popup/company_detail.cfm?referer=Drayage.com&cID=3435&m=BIR&code=BIR'

这里是{@ 3}}的来源,该网站来自众多城市之一(这是伯明翰,其中有102个城市页面以及1000多家服务提供商)

这是我完成的完整VBA代码https://pastebin.com/mj7tDgqn

我觉得我在GetOneTable下的此子项中有问题,一旦到达正确的页面,就会调用另一个子项来执行操作。它虽然未在正确的位置或所有表数据中拉出信息,但信息不正确。似乎只是最后一行。

Sub GetOneTable(d, n, z)' n is the table to extract
Dim e As Object ' the elements of the document
Dim t As Object ' the table required
Dim r As Object ' the rows of the table
Dim c As Object ' the cells of the rows.
Dim I As Long
Dim J As Long
On Error Resume Next
Sheets("Target").Select

    For Each e In d.all
        If e.nodename = "TABLE" Then
            J = J + 1
        End If
        If J = n Then
            Set t = e
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set Rng = Range("t" & z)
            For Each r In t.Rows
                For Each c In r.Cells
                    Rng.Value = c.innerhtml 
                    Set Rng = Rng.Offset(, 1)
                    I = I + 1
                Next c

                Set Rng = Rng.Offset(, -I)
                I = 0
            Next r
            Exit For
                 Cells.WrapText = False
        End If
    Next e

    nextrow = nextrow + 1

On Error GoTo 0

End Sub

0 个答案:

没有答案