如何获取不同帧中的表数据excel vba

时间:2017-08-27 16:21:53

标签: excel vba excel-vba html-table

Option Explicit
Option Compare Text

Dim fRD As Long, i As Long, fSR As Long, j As Long
Dim pID As String
Dim IE As SHDocVw.InternetExplorer
Dim Doc As MSHTML.HTMLDocument
Dim urL As String
Dim fnd As Boolean
Dim hiddenPID
Dim elemColl
Dim elemCOllection
Dim r As Long, t As Long, c As Long

Sub genOP()

With RD

    fRD = .Range("A" & .Rows.Count).End(xlUp).Row
    Set IE = New SHDocVw.InternetExplorer
    urL = "http://eringcapture.jccal.org/caportal/CAPortal_MainPage.aspx"

    For i = 2 To 2

        fSR = SR.Range("A" & SR.Rows.Count).End(xlUp).Row + 1
        pID = Trim(Format(.Range("A" & i).Value, "0"))    ' get PID

        If Len(pID) < 8 Then GoTo nextRow

        IE.Visible = True
        IE.navigate urL

        Call WaitForIE
        Set Doc = IE.document
        Doc.getElementById("Iframe1").contentDocument.getElementById("RealSearchLink").Click
        Call WaitForIE
        Doc.getElementById("Iframe1").contentDocument.getElementById("SearchByParcel").Checked = True

        'SearchByTB
        'Delete the first 2 digits from the excel data (parcel ID), e.g. 22002240080330000000 (instead of 0122002240080330000000)
        pID = Mid(pID, 2, 16)

        Call EnterIDSubmit
        Call WaitForIE

        If Trim(Doc.getElementById("Iframe1").contentDocument.getElementById("TotalRecFound").innerText) <> "No Records Found." Then

            'Result Found
            Set elemColl = Doc.getElementById("Iframe1").contentDocument.getElementsByClassName("Header1Font")
            elemColl(0).Click
            Call WaitForIE

            SR.Range("A" & fSR) = Trim(Format(.Range("A" & i).Value, "0"))
            SR.Range("B" & fSR) = hiddenPID

            'id = MainTable
            'Set elemCOllection = IE.document.getElementsByTagName("TABLE")
            TEMP.Cells.Clear

            'Set elemCOllection = Doc.getElementById("Iframe2").contentDocument.getElementById("MainTable")
            'Set elemCOllection = Doc.getElementById("Iframe2").contentDocument.getElementById("MainTable")
            r = 1
            For Each elemColl In Doc.getElementById("Iframe1").getElementsByTagName("td")
                TEMP.Cells(r, 0).Value = elemColl.innerText
                r = r + 1
            Next

'            For t = 0 To (elemCOllection.Length - 1)
'                For r = 0 To (elemCOllection(t).Rows.Length - 1)
'                    For c = 0 To (elemCOllection(t).Rows(r).Cells.Length - 1)
'                        TEMP.Cells(r + 1, c + 1) = elemCOllection(t).Rows(r).Cells(c).innerText
'                    Next c
'                Next r
'            Next t


            Stop
        Else
            'Result Not Found
            SR.Range("A" & fSR) = "No Records Found"
        End If



nextRow:
    Next i

    IE.Quit
    Set IE = Nothing

End With

MsgBox "Process Completed"

End Sub

Sub EnterIDSubmit()

hiddenPID = Left(pID, 2) & " " & Mid(pID, 3, 2) & " " & _
    Mid(pID, 5, 2) & " " & _
    Mid(pID, 7, 1) & " " & Mid(pID, 8, 3) & " " & _
    Mid(pID, 11, 3) & "." & Mid(pID, 14, 2)

    Doc.getElementById("Iframe1").contentDocument.getElementById("SearchText").Value = pID    'Put id in text box
    Doc.getElementById("Iframe1").contentDocument.getElementById("HidParcelNo").Value = hiddenPID  'Put hidden pID in the hidden element
    Doc.getElementById("Iframe1").contentDocument.getElementById("Search").Click  'search button

End Sub

Sub WaitForIE()
While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
    DoEvents
Wend
End Sub

我想从以下步骤访问的网页获取数据:

  1. 访问网址:http://eringcapture.jccal.org/caportal/CAPortal_MainPage.aspx

  2. 点击该网页底部的Search your Real Property. Click Here

  3. 输入包裹号码:22002240080330

  4. 点击第一个结果的链接

  5. 现在这些表位于不同的框架中,我无法弄清楚如何访问表格数据。

1 个答案:

答案 0 :(得分:2)

您不必访问该网址,点击等,您只需要对此网址发出GET请求:

vss-extension.json

然后,您可以使用IE对象的 .getElementsByTagName(“td”)方法轻松获取表格数据,并检查.innerHtml中是否存在您需要的数据,而无需迭代很多嵌套项目。