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

Question

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

我正在尝试从下面的网络链接中获取“所有者姓名”和“邮寄地址”

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

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

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

您可以使用css pattern#ownerInformationDiv table:nth-child(1) 隔离这两个表，通过应用ie.document 的querySelectorAll 方法在nodeList 中返回。

循环每个表，在给定的表中，循环行（忽略标题行）并连接在每行中找到的文本。合并文本后，对于给定的表格，将其写到工作表中。

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

整页加载等待

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

具有类的限定对象

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