通过代码从网络获取相关详细信息

Question

嗨，我是 VBA 的新手，正在尝试提升我在 VBA 的技能。

我正在尝试从以下网站获取“所有者姓名”和“邮寄地址”link

https://www.pbcgov.org/papa/Asps/PropertyDetail/PropertyDetail.aspx?parcel=30424032060001820

在 Sheet1"A1" 中使用此 ID

30-42-40-32-06-000-1820（该ID与姓名和邮寄地址将粘贴在Col“B”和Col“C”中的人有关。

我试过了，但没能成功。

任何人的帮助将不胜感激。

Sub Data()

    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True

    Url = "https://www.pbcgov.org/papa/?fbclid=IwAR28Ao4d0Ic5hTcd4w6BYv5FwaVYKFc3sCtmcqPI8Ctw2Q0jUy2zIdc7I-c"

    'Wait for site to fully load
    ie.Navigate2 Url
    
    Do While ie.Busy = True
        DoEvents
    Loop

    RowCount = 1

    With Sheets("Sheet1")
        .Cells.ClearContents
        RowCount = 1
        For Each itm In ie.document.all
            .Range("A" & RowCount) = itm.tagname
            .Range("B" & RowCount) = itm.ID
            .Range("c" & RowCount) = Left(itm.innertext, 1024)

            RowCount = RowCount + 1
        Next itm
    End With
    
End Sub

Answer 1

这可能有点高级，但提供了另一种看待问题的方式。

您想要的信息分布在两个 table 中，并且在这些 table 中有两行。一个 table 用于所有者信息（分为几行）；和一个 table，同样，用于地址。

您可以使用 ie.document 的 css pattern #ownerInformationDiv table:nth-child(1) to isolate both of those tables, returned in a nodeList by applying querySelectorAll 方法。

循环每个 table，并在给定的 table 中循环行（忽略 header 行）并连接每行中找到的文本。合并文本后，对于给定的 table，将其写出到 sheet.

其他需要注意的事项包括：

整页加载等待

While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend

排位赛object class

Dim ie As SHDocVw.InternetExplorer

使用描述性标题

Public Sub WriteOutOwnersInfo()

VBA:

Option Explicit

Public Sub WriteOutOwnersInfo()

    Dim ie As SHDocVw.InternetExplorer
    
    Set ie = New SHDocVw.InternetExplorer
    
    With ie
        .Visible = True
        .Navigate2 "https://www.pbcgov.org/papa/Asps/PropertyDetail/PropertyDetail.aspx?parcel=30424032060001820"
        While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend

        Dim tables As Object
        
        Set tables = .Document.querySelectorAll("#ownerInformationDiv table:nth-child(1)")
 
        Dim currTable As Object, currRow As Object, c As Long
        Dim i As Long, j As Long, lineOutput As String
        
        For i = 0 To tables.Length - 1
            Set currTable = tables.Item(i)
            lineOutput = vbNullString
            
            For j = 1 To tables.Item(i).Rows.Length - 1
                Set currRow = currTable.Rows(j)
                lineOutput = lineOutput & Chr$(32) & Trim$(currRow.innertext)
            Next
            c = c + 1
            ActiveSheet.Cells(1, c) = Trim$(lineOutput)
        Next
        .Quit
    End With
    
End Sub

通过代码从网络获取相关详细信息

Getting a relevant details from web via code

excel

internet-explorer

vba

web-scraping