Excel 无法从网页获取数据-dom查询

我使用该代码自动从网站获取一些字段，并用搜索结果填充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

---

首先，声明

searchUrl

的那一行已被注释掉。我不确定这是否是故意的。因此，首先删除

Const searchUrl

前面的

“

其次，将您的

searchUrl

更改为此（基本上将http更改为https）：

最后，我编辑了你文章中的代码格式。接受编辑并使用该格式。那里有一些换行符，可能会出错

---

您应该准备好开始了。

这里有一个更有效的重写。我将

winhttp.winhttprequest.5.1

和

dom

对象的创建移出循环，以避免持续创建和销毁。将

屏幕更新

移出，因此仅在开始和结束时处理。将返回的记录和循环范围设置为变量，以便从中访问

通常，我会将要循环的值加载到数组中，然后循环数组。我会将结果存储在一个数组中，并在末尾写一次，因为经常触摸纸张是很昂贵的。因为我不知道其他专栏中发生了什么，而且似乎在您的数据范围中可能存在差距，所以我没有做这些修改

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

---

用

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声明的，对吗？因为它肯定不会像那样工作…注释掉的行是我的粘贴错误，我在发布问题之前尝试了不同的选项。。。。