2017-08-27 14 views
0
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 

我想從其中通過以下步驟訪問的網頁中獲取數據:如何得到這是在不同的幀表數據Excel VBA中

  1. 訪問網址:http://eringcapture.jccal.org/caportal/CAPortal_MainPage.aspx

  2. 點擊Search your Real Property. Click Here這是在該網頁的底部。

  3. 輸入包裹#:22002240080330

  4. 點擊第一個結果的鏈接

現在的表是在不同的框架和我想不通我怎麼能訪問表數據。

+0

爲什麼不使用XHR代替pf IE? – omegastripes

+0

@omegastripes,因爲我不知道如何實現這裏 – Rohan

回答

2

您沒有訪問該網址,點擊諸如此類,你可以只是做一個GET請求到這個網址:

Const tablesUrl As String = "http://eringcapture.jccal.org/caportal/CA_PropertyTaxParcelInfo.aspx?ParcelNo=*PARCELNO*&TaxYear=*TAXYEAR*" 
Const summaryUrl As String = "http://eringcapture.jccal.org/caportal/CA_PTSummary.aspx?ParcelNum=*PARCELNO*&RecordYear=*TAXYEAR*" 
Dim url As String 

Sub genOP() 
    'Just a sample sub, use breakpoint to see what you get after navigating the urls 
    Set IE = New SHDocVw.InternetExplorer 

    taxYear = 2017 
    parcelNo = "22+00+22+4+008+033.000" 'you should recreate that dinamically based on the parcel 

    'This for both tables url with header and select year box 
    url = Replace(Replace(tablesUrl, "*PARCELNO*", parcelNo), "*TAXYEAR*", taxYear) 
    IE.Visible = True 
    IE.navigate url 

    'this for the tax/summary tables only 
    url = Replace(Replace(summaryUrl, "*PARCELNO*", parcelNo), "*TAXYEAR*", taxYear) 
    IE.Visible = True 
    IE.Navigate url 
End Sub 

然後你就可以輕鬆達到與.getElementsByTagName表數據(」 td「)方法的IE對象,並檢查.innerHtml中是否有你需要的數據,而不是遍歷大量的嵌套項目。

+0

非常感謝! – Rohan

相關問題