使用vba从网站中抓取数据-问题_Vba_Ms Access_Web Scraping

使用vba从网站中抓取数据-问题

vba ms-access web-scraping

使用vba从网站中抓取数据-问题,vba,ms-access,web-scraping,Vba,Ms Access,Web Scraping,我正在尝试从搜索中的每个设施中获取地址、设施类型和一些其他数据。我能够获得搜索结果和设施列表，但我不知道如何从页面中获取数据编辑我已经在答案中应用了建议，这是新代码，对象必需错误在调试行我试着点击每个链接，获取名称、地址、设施类型以及页面上的任何其他数据 Sub Test() Dim ie2 As New InternetExplorer 'Set ie = New InternetExplorerMedium With ie2 .Visible

我正在尝试从搜索中的每个设施中获取地址、设施类型和一些其他数据。我能够获得搜索结果和设施列表，但我不知道如何从页面中获取数据

编辑我已经在答案中应用了建议，这是新代码，对象必需错误在调试行我试着点击每个链接，获取名称、地址、设施类型以及页面上的任何其他数据

Sub Test()
    Dim ie2 As New InternetExplorer
    'Set ie = New InternetExplorerMedium

    With ie2
        .Visible = True
        .navigate "https://healthapps.state.nj.us/facilities/fsSetSearch.aspx?by=county"

        FacType = "Long-Term Care (Nursing Homes)"
        While .Busy Or .ReadyState < 4: DoEvents: Wend

        With .Document
            .querySelector("#middleContent_cbType_0").Click
            .querySelector("#middleContent_btnGetList").Click
        End With
            
        While .Busy Or .ReadyState < 4: DoEvents: Wend
            

        Pause (2)
        
        Dim list2 As Object, i2  As Long, line1 As String, line2 As String

        Set list2 = .Document.querySelectorAll("[href*='fsFacilityDetails.aspx?item=']")
        
        For i2 = 0 To list2.Length - 1
            list2.Item(i2).Click
            Debug.Print .Document.querySelector(".infotable tr:nth-of-type(3) td + td").innerText
            
            While .Busy Or .ReadyState < 4: DoEvents: Wend

            Pause (2)

            address = Replace(Replace(Replace(line1 & " " & line2, "<span id=" & Chr(34) & "middleContent_lbAddress" & Chr(34) & ">", ""), "<br>", ", "), "</span>", "")

            WriteTable .Document.getElementsByTagName("table")(3), .Document.getElementById("middleContent_Menu1").innerText

            .Navigate2 .Document.URL
            While .Busy Or .ReadyState < 4: DoEvents: Wend
            Set list2 = .Document.querySelectorAll("[href*='fsFacilityDetails.aspx?item=']")

        Next
        .Quit                                    '
    End With

End Sub

子测试（）
Dim ie2作为新的InternetExplorer
'Set ie=New InternetExplorerMedia
使用ie2
.Visible=True
.导航“https://healthapps.state.nj.us/facilities/fsSetSearch.aspx?by=county"
FacType=“长期护理（疗养院）”
当.Busy或.ReadyState<4:DoEvents:Wend时
随附.文件
.querySelector（“#middleContent_cbType_0”）。单击
.querySelector（“#中间内容列表”）。单击
以
当.Busy或.ReadyState<4:DoEvents:Wend时
暂停（2）
Dim list2作为对象，i2作为长度，line1作为字符串，line2作为字符串
Set list2=.Document.querySelectorAll（“[href*='fsFacilityDetails.aspx？item=']”）
对于列表2，i2=0。长度为-1
列表2.项目（i2）。单击
Debug.Print.Document.querySelector（“.infotable tr:nth类型（3）td+td”）.innerText
当.Busy或.ReadyState<4:DoEvents:Wend时
暂停（2）
地址=替换（替换（替换（第1行和第2行），，，，，，，，，，，，）
WriteTable.Document.getElementsByTagName（“表”）（3）、.Document.getElementById（“middleContent\u Menu1”）.innerText
.Navigate2.Document.URL
当.Busy或.ReadyState<4:DoEvents:Wend时
Set list2=.Document.querySelectorAll（“[href*='fsFacilityDetails.aspx？item=']”）
下一个
.退出'
以
端接头

我在这一行得到了对象所需的错误

Address=Replace（Replace（Replace）（Replace（.Document.getElementById（“middleContent\lbAddress”）.outerHTML，“，”，“
”，“，”，”，“，”，”）

但我很确定我用的是错误的方法来获取数据。所以，即使没有错误，我也不会给我我所需要的

Sub Test()
    Dim ie2 As New InternetExplorer
    'Set ie = New InternetExplorerMedium

    With ie2
        .Visible = False
        .navigate "https://healthapps.state.nj.us/facilities/fsSetSearch.aspx?by=county"

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

        With .Document
            .querySelector("#middleContent_cbType_0").Click
            .querySelector("#middleContent_btnGetList").Click
        End With
            
        While .Busy Or .ReadyState < 4: DoEvents: Wend
            
        Dim list2 As Object, i2  As Long
        Set list2 = .Document.querySelectorAll("#main_table")
             
        For i2 = 0 To list2.Length - 1
            list2.Item(i2).Click

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

            Pause (2)
    
            If .Document.getElementById("middleContent_lbResultTitle") Is Nothing Then
                Pause (5)
            End If

            If .Document.getElementById("middleContent_lbResultTitle").outerHTML Like "*Long-Term Care Facility*" Then
                FacType = "Long-Term Care (Nursing Homes)"
            End If

            Address = Replace(Replace(Replace(.Document.getElementById("middleContent_lbAddress").outerHTML, "<span id=" & Chr(34) & "middleContent_lbAddress" & Chr(34) & ">", ""), "<br>", ", "), "</span>", "")

            WriteTable .Document.getElementsByTagName("table")(3), .Document.getElementById("middleContent_Menu1").innerText


            .Navigate2 .Document.URL
            While .Busy Or .ReadyState < 4: DoEvents: Wend
            Set list2 = .Document.querySelectorAll("#main_table")

        Next
        .Quit                                    '
    End With
End Sub

子测试（）
Dim ie2作为新的InternetExplorer
'Set ie=New InternetExplorerMedia
使用ie2
.Visible=False
.导航“https://healthapps.state.nj.us/facilities/fsSetSearch.aspx?by=county"
当.Busy或.ReadyState<4:DoEvents:Wend时
随附.文件
.querySelector（“#middleContent_cbType_0”）。单击
.querySelector（“#中间内容列表”）。单击
以
当.Busy或.ReadyState<4:DoEvents:Wend时
将列表2设置为对象，将i2设置为长
Set list2=.Document.querySelectorAll（“主表”）
对于列表2，i2=0。长度为-1
列表2.项目（i2）。单击
当.Busy或.ReadyState<4:DoEvents:Wend时
暂停（2）
如果.Document.getElementById（“middleContent\lbresultitle”）什么都不是，那么
暂停（5）
如果结束
如果.Document.getElementById（“middleContent\lbresultitle”）.outerHTML类似于“*长期护理机构*”，那么
FacType=“长期护理（疗养院）”
如果结束
Address=Replace（Replace（Replace（.Document.getElementById（“middleContent\lbAddress”）.outerHTML，“，”，“
”，“，”，”，“，”，”）
WriteTable.Document.getElementsByTagName（“表”）（3）、.Document.getElementById（“middleContent\u Menu1”）.innerText
.Navigate2.Document.URL
当.Busy或.ReadyState<4:DoEvents:Wend时
Set list2=.Document.querySelectorAll（“主表”）
下一个
.退出'
以
端接头

这是一个单节点

集合list2=.Document.queryselectoral（“#main_table”）

。相反，假设所有结果的结构相同，请使用以下内容：

Dim i As Long, line1 As String, line2 As String, address As String

Set list2 = .Document.querySelectorAll("[href*='fsFacilityDetails.aspx?item=']")

For i = 0 To list2.Length - 1
    line1 = list2.Item(i).NextSibling.NextSibling.NodeValue
    line2 = list2.Item(i).NextSibling.NextSibling.NextSibling.NodeValue
    address = line1 & " " & line2 'apply string cleaning here
Next

这首先针对每个结果的超链接，然后使用nextSibling跨br元素移动，以获得地址行1和2。您需要在address变量上写入一些字符串清理

如果您决定单击每个超链接，则在详细信息页面上使用

.document.querySelector（“.infotable tr:nth类型（3）td+td”）.innerText

检索完整地址

导航到每个页面的示例（检查检索到的URL是否完整且不需要前缀）

Dim i尽可能长，地址尽可能长，URL（）尽可能长，numLinks尽可能长
Set list2=.Document.querySelectorAll（“[href*='fsFacilityDetails.aspx？item=']”）
numLinks=List.Length-1
ReDim URL（0到numLinks）
对于i=0到numLinks
URL（i）=list2.Item（i）.href
下一个
对于i=0到numLinks
.导航2 URL（i）
忙时或准备时状态4:DoEvents:Wend
“时间循环可能就在这里
地址=.Document.querySelector（“.infotable tr:nth类型（3）td+td”）.innerText
调试.打印地址
下一个

您可能希望将地址行设置为变量，介于出错时继续下一步和出错时转到0之间，然后在访问nodeValue之前进行测试，以防页面之间存在html差异。嘿，我记得您）））无法使其工作，需要对象。我将发布我现在使用的原始代码。是的，我想点击每个链接，因为除了每个详细页面的地址之外，我还需要其他东西，你需要在该行的新页面上。也就是说，您需要首先提取每个href并导航到它，然后确保等待页面加载，然后使用该行。您可能需要一个定时循环才能显示元素。我在上面添加了一个示例，我将尝试找出这个例子。这并不急，所以我想学习一下。威尔·沃尔

Dim i As Long, address As String, urls(), numLinks As Long

Set list2 = .Document.querySelectorAll("[href*='fsFacilityDetails.aspx?item=']")
numLinks = List.Length - 1
ReDim urls(0 To numLinks)

For i = 0 To numLinks
    urls(i) = list2.Item(i).href
Next

For i = 0 To numLinks
    .navigate2 urls(i)
    While .Busy Or .ReadyState <> 4: DoEvents: Wend
    'time loop maybe goes here
    address = .Document.querySelector(".infotable tr:nth-of-type(3) td + td").innerText
    Debug.Print address
Next