Как удалить данные с веб-сайта, посвященного налогу на имущество - PullRequest
Новая
       0

Как удалить данные с веб-сайта, посвященного налогу на имущество

1 голос
/ 17 июня 2020

Я хочу поскрести кое-что с этой страницы http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id=1229623

  1. Мне нужен идентификатор свойства: под таблицей свойств
  2. Sqft и Market Значение в таблице земель
  3. Улучшение № 1 в разделе Улучшение / Строительство

и обнаружено несколько проблем

  1. Я не могу найти ни одной комбинации elementID или имя тега / класса, чтобы получить эту информацию
  2. То же, что и выше
  3. Я хочу только вытащить первый элемент в списке и добавить (0) в несколько мест в моем коде ниже isn ' Работаем, чтобы это произошло

Я думал, что лучший способ сделать это - создать подпрограммы ProcessHTMLPage ProcessHTMLPage2 и ProcessHTMLPage3, которые делают все это, а затем я могу работать над форматированием, чтобы поместить их в соответствующие столбцы по мере необходимости 

Sub GetHTMLDocumentXML()

    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim HTMLPage As MSHTML.HTMLDocument
    Dim URL As String
    Dim HTMLDiv As MSHTML.IHTMLElement
    Dim HTMLTable As MSHTML.IHTMLElement


    XMLPage.Open "GET", "http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id=1229623", False
    XMLPage.send

    If XMLPage.Status <> 200 Then
        MsgBox XMLPage.Status & " - " & XMLPage.statusText
        Exit Sub
    End If

    HTMLDoc.body.innerHTML = XMLPage.responseText

    ProcessHTMLPage2 HTMLDoc

End Sub

Sub ProcessHTMLPage2(HTMLPage As MSHTML.HTMLDocument)

    Dim HTMLTable As MSHTML.IHTMLElement
    Dim HTMLTables As MSHTML.IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    Dim HTMLCell As MSHTML.IHTMLElement
    Dim RowNum As Long, ColNum As Integer

    Set HTMLTables = HTMLPage.getElementsByClassName("improvements")

    Cells.Clear

    For Each HTMLTable In HTMLTables

        Debug.Print HTMLTable.className
        RowNum = RowNum + 1

        For Each HTMLRow In HTMLTable.getElementsByTagName("tr")
            Debug.Print vbTab & HTMLRow.innerText
            ColNum = 1


            For Each HTMLCell In HTMLRow.Children
                Debug.Print vbTab & HTMLCell.innerText
                Cells(RowNum, ColNum) = HTMLCell.innerText
                ColNum = ColNum + 1

            Next HTMLCell

        Next HTMLRow
    Next HTMLTable

    Range("A1").Select
    ActiveCell.CurrentRegion.EntireColumn.AutoFit
End Sub

1 Ответ

1 голос
/ 17 июня 2020

Попробуйте следующее, чтобы получить Property ID, Sqft, Market Value с этой веб-страницы. Мне пришлось использовать жестко запрограммированный индекс, чтобы найти последние два элемента, так как я не смог найти какой-либо конкретный c маркер. 

Public Sub FetchInfo()
    Const Url$ = "http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id=1229623"
    Dim S$, oItem As Object
    Dim propertyId$, Sqft$, marketValue$

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.97 Safari/537.36"
        .send
        S = .responseText
    End With

    With CreateObject("HTMLFile")
        .write S
        For Each oItem In .getElementsByTagName("td")
            If InStr(oItem.innerText, "Property ID:") > 0 Then
                propertyId = oItem.NextSibling.innerText
                Exit For
            End If
        Next oItem

        Sqft = .getElementById("landDetails").getElementsByTagName("td")(4).innerText
        marketValue = .getElementById("landDetails").getElementsByTagName("td")(7).innerText

        Debug.Print propertyId, Sqft, marketValue
    End With
End Sub
...