从 url 不变的网页源中抓取数据

Question

我需要做以下事情

• 转到 http://healthapps.state.nj.us/facilities/acSetSearch.aspx?by=county

• 选择“特殊医院”和“所有门诊医疗设施**注意 #2”

• 点击搜索
• 遍历列表中的所有医院
• 点击各个医院
• 从医院页面获取一些数据

我有两个问题

1. 我不知道如何选择“特殊医院”和“所有门诊医疗设施**注意 #2”
2. 当我手动选择这 2 种类型，然后单击某些医院时，URL 不会成为特定选择。 在我选择了 2 种类型后它变成了http://healthapps.state.nj.us/facilities/acFacilityList.aspx，然后当我点击医院时保持这种状态。 因此，我无法编写抓取这些页面的代码，因为我不知道如何为每家医院指定 URL。

抱歉，这必须是一个非常基本的问题，但我无法通过谷歌搜索任何对 Access VBA 有用的内容

这是从页面拉取数据的代码，我还没有做循环，所以这只是一个页面背后的源数据的基本拉取

Public Function btnGetWebData_Click() 
    Dim strURL
    Dim HTML_Content As HTMLDocument
    Dim dados As Object

    'Create HTMLFile Object
    Set HTML_Content = New HTMLDocument

    'Get the WebPage Content to HTMLFile Object
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://healthapps.state.nj.us/facilities/acFacilityList.aspx", False
        'http://healthapps.state.nj.us/facilities/acFacilityList.aspx
        .Send
        HTML_Content.Body.innerHTML = .responseText
        Debug.Print .responseText
        Debug.Print HTML_Content.Body.innerHTML
    End With
End Function

Answer 1

它导航到每个结果页面，并在其间返回主页，以便通过点击利用 postBack 链接。

Option Explicit
Public Sub VisitPages()
    Dim IE As New InternetExplorer
    With IE
        .Visible = True
        .navigate "http://healthapps.state.nj.us/facilities/acSetSearch.aspx?by=county"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("#middleContent_cbType_5").Click
            .querySelector("#middleContent_cbType_12").Click
            .querySelector("#middleContent_btnGetList").Click
        End With

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim list As Object, i  As Long
        Set list = .document.querySelectorAll("#main_table [href*=doPostBack]")
        For i = 0 To list.Length - 1
            list.item(i).Click

            While .Busy Or .readyState < 4: DoEvents: Wend

            Application.Wait Now + TimeSerial(0, 0, 3) '<== Delete me later. This is just to demo page changes
            'do stuff with new page
            .Navigate2 .document.URL             '<== back to homepage
            While .Busy Or .readyState < 4: DoEvents: Wend
            Set list = .document.querySelectorAll("#main_table [href*=doPostBack]") 'reset list (often required in these scenarios)
        Next
        Stop                                     '<== Delete me later
        '.Quit '<== Remember to quit application
    End With
End Sub

---

与执行 postBacks 相同

Option Explicit
Public Sub VisitPages()
    Dim IE As New InternetExplorer
    With IE
        .Visible = True
        .navigate "http://healthapps.state.nj.us/facilities/acSetSearch.aspx?by=county"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("#middleContent_cbType_5").Click
            .querySelector("#middleContent_cbType_12").Click
            .querySelector("#middleContent_btnGetList").Click
        End With

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim list As Object, i  As Long, col As Collection
        Set col = New Collection
        Set list = .document.querySelectorAll("#main_table [href*=doPostBack]")
        For i = 0 To list.Length - 1
           col.Add CStr(list.item(i))
        Next
        For i = 1 To col.Count
            .document.parentWindow.execScript col.item(i)
             While .Busy Or .readyState < 4: DoEvents: Wend
            'Do stuff with page
            .Navigate2 .document.URL
            While .Busy Or .readyState < 4: DoEvents: Wend
        Next
        Stop                                     '<== Delete me later
        '.Quit '<== Remember to quit application
    End With
End Sub