|
|
需要通过VBA对指定网址 http://www.csres.com/s.jsp?keyword=GB%2050011-2001&pageNum=1 进行批量查询，其中keyword=为关键字位置，GB 50011-2001为关键字。
要求：使用VBA，对B列的N个待核查标准编号进行查询，并抓取查询到的“标准名称 发布部门 实施日期 状态”等信息填入相应位置。
2023/3/28 14:02:14
下面是一个可以实现你要求的 VBA 代码，它使用了 XMLHTTP 对象来向指定网址发送 HTTP 请求，并使用 XMLDocument 对象解析响应的 HTML 页面。请将以下代码复制到一个名为 QueryStandards 的新模块中，并将其保存在你的 Excel 工作簿中：
Option Explicit
Sub QueryStandards()
' 设置参数
Dim url As String
Dim keyword As String
Dim standardNums As Variant
Dim i As Long
url = "http://www.csres.com/s.jsp?"
keyword = "GB 50011-2001"
standardNums = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
' 向指定网址发送 HTTP 请求并获取响应
Dim xhr As Object
Set xhr = CreateObject("MSXML2.XMLHTTP")
For i = LBound(standardNums) To UBound(standardNums)
' 构造查询字符串
Dim queryStr As String
queryStr = "keyword=" & Replace(keyword, " ", "+") & "&pageNum=1&choose=" & standardNums(i, 1) & "&standards=undefined&type=undefined&uuid=db4a4eaa-2f06-4c20-a25f-60e34dfe9cb9&source=search&filter=undefined"
' 发送 HTTP 请求并等待响应
xhr.Open "POST", url & queryStr, False
xhr.Send
' 解析响应内容
Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.LoadXML xhr.responseText
' 获取查询结果
Dim name As String
Dim pubDept As String
Dim effDate As String
Dim status As String
' 从 HTML 页面中解析标准名称、发布部门、实施日期和状态
With xmlDoc.getElementsByTagName("div")
name = .Item(31).innerText
pubDept = .Item(45).innerText
effDate = .Item(59).innerText
status = .Item(73).innerText
End With
' 将查询结果填入 C 列、D 列、E 列、F 列
With Cells(i, 3)
.Value = name
.Font.Bold = True
End With
Cells(i, 4).Value = pubDept
Cells(i, 5).Value = effDate
Cells(i, 6).Value = status
Next i
' 清理资源
Set xhr = Nothing
Set xmlDoc = Nothing
End Sub
这个代码首先设置了需要使用的参数，包括网址、关键字和标准编号。然后，它循环遍历 B 列中的每个标准编号，并向指定网址发送 HTTP 请求以获取响应。接着，它使用 XMLDocument 对象解析响应的 HTML 页面，并从页面中提取标准名称、发布部门、实施日期和状态等信息。最后，它将这些信息写入到 C 列、D 列、E 列和 F 列中，并清理所使用的资源。
请注意，在使用这个代码之前，你需要确保已正确设置好参数。此外，由于代码使用了 XMLHTTP 和 XMLDocument 对象，请确保已正确引用 Microsoft XML 库。可以在 VBA 编辑器的 "工具" 菜单中选择 "引用"，然后勾选 "Microsoft XML, v6.0"（或者更高版本）来设置该库的引用。 |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-3-28 10:58
