无法从网页中获取数据 - dom 查询答案

【问题标题】：unable to fetch data from web page - dom query无法从网页中获取数据 - dom 查询
【发布时间】：2019-09-04 01:18:26
【问题描述】：

我使用该代码自动从网站获取一些字段并用搜索结果填充 excel 表，但我认为网站上发生了一些变化，我无法让该代码再次工作...有什么帮助和建议吗？

Sub Scramble_NAVY_search()

Dim cel As Range, ms As Worksheet, dom As HTMLDocument
Set ms = Sheets("Scramble")
'Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"

For Each cel In ms.Range("B2:B" & ms.Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(2)
    Set dom = New HTMLDocument
    Application.ScreenUpdating = False
    With CreateObject("winhttp.winhttprequest.5.1")
        .Open "POST", searchUrl, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "Itemid=60&af=usn&serial=" & cel & "&sbm=Search&code=&searchtype=&unit=&cn="
        dom.body.innerHTML = .responseText
    End With

    On Error Resume Next
    With cel
        If .Offset(, -1).Value = "" Then
            .Offset(, 2) = dom.getElementsByClassName("rowBord")(0).Cells(1).innerText 'Code
            .Offset(, -1) = dom.getElementsByClassName("rowBord")(0).Cells(2).innerText 'Type
            .Offset(, 10) = dom.getElementsByClassName("rowBord")(0).Cells(3).innerText 'C/N
            .Offset(, 3) = dom.getElementsByClassName("rowBord")(0).Cells(4).innerText 'Unit
            .Offset(, 11) = dom.getElementsByClassName("rowBord")(0).Cells(5).innerText 'Status
        End If
    End With
   Next

    End Sub

【问题讨论】：

使用F8 单步执行代码，看看哪一行出现错误。您提供了一些代码，但未指定您期望的输出（或您希望从网站获取的数据）。如果我在浏览器中导航到 https://www.scramble.nl/?option=com_mildb&view=search&Itemid=60&af=usn&serial=&sbm=Search&code=&searchtype=&unit=&cn=，我会看到一堆搜索字段（但在页面的 HTML 或 CSS 中没有名为 rowBord 的类）。
我怀疑你故意注释掉了 searchUrl 声明，对吧？因为它绝对不会那样工作..
注释掉的行是我的粘贴错误，我在发布问题之前尝试了不同的选项....

标签： excel vba web-scraping xmlhttprequest fetch

【解决方案1】：

这是一个稍微更有效的重写。我将winhttp.winhttprequest.5.1 和dom 对象的创建移出循环，以避免不断创建和销毁。将Screenupdating 移出，因此仅在开始和结束时处理。将返回的记录和循环范围设置为变量，以便您从中访问。

通常，我会加载要循环到数组中的值并循环数组。我会将结果存储在一个数组中并在最后写出一次，因为不断触摸工作表很昂贵。由于我不知道其他列中发生了什么，而且您的数据范围内似乎存在空白，因此我没有进行这些修改。

Option Explicit

Public Sub ScrambleNavySearch()
    Dim cel As Range, ms As Worksheet, dom As HTMLDocument, loopRange As Range
    Const SEARCH_URL As String = "https://www.scramble.nl/index.php?option=com_mildb&view=search"

    Set ms = ThisWorkbook.Worksheets("Scramble")
    Set dom = New HTMLDocument
    Set loopRange = ms.Range("B2:B" & ms.Range("B" & rows.Count).End(xlUp).Row).SpecialCells(2)

    Application.ScreenUpdating = False

    With CreateObject("winhttp.winhttprequest.5.1")

        For Each cel In loopRange

            .Open "POST", SEARCH_URL, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send "Itemid=60&af=usn&serial=" & cel & "&sbm=Search&code=&searchtype=&unit=&cn="
            dom.body.innerHTML = .responseText
            Dim recordFields As Object

            Set recordFields = dom.querySelectorAll(".rowBord td")

            If recordFields.Length > 0 Then
                With cel
                    .Offset(, -1) = recordFields.item(2).innerText 'Type
                    .Offset(, 2) = recordFields.item(1).innerText 'Code
                    .Offset(, 3) = recordFields.item(4).innerText 'Unit
                    .Offset(, 10) = recordFields.item(3).innerText 'C/N
                    .Offset(, 11) = recordFields.item(5).innerText 'Status
                End With
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

【讨论】：

【解决方案2】：

首先，声明searchUrl 的行已被注释掉。我不确定这是否是故意和故意的。所以首先删除Const searchUrl前面的'。

其次，把你的searchUrl改成这个（基本上把http改成https）：

https://www.scramble.nl/index.php?option=com_mildb&view=search

最后，我编辑了您帖子中的代码格式。接受编辑并使用该格式。那里有一些换行符会产生错误。

你应该准备好了。

【讨论】：