はVBA

2017-08-27 8 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 

エクセル私は、次の手順でアクセスしたウェブページからデータを取得したい:はVBA

  1. 訪問のURL:http://eringcapture.jccal.org/caportal/CAPortal_MainPage.aspx

  2. は上をクリックしますSearch your Real Property. Click Hereは、そのWebページの最下部にあります。今、テーブルは異なるフレームにあり、私はテーブルにアクセスする方法を見つけ出すことはできません22002240080330

  3. クリックして、最初の結果

のリンク上:

  • は、小包番号を入力します。データ。

  • +0

    IEの代わりにXHRを使用してみませんか? – omegastripes

    +0

    @omegastripesここに実装する方法がわからないので – Rohan

    答えて

    2

    あなたはエトセトラをクリックすると、そのURLにアクセスする必要はありません、あなたはこのURLに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