html - Web 抓取:运行时错误 91 未设置对象变量
问题描述
我正在尝试使用来自该网站的信息更新我的物种数据库:https ://www.afcd.gov.hk/english/conservation/hkbiodiversity/database/search.php
我在 A 列中有一个物种列表的 xlsm,并在网站的搜索引擎中搜索它们中的每一个,这会导致一个页面显示指向该特定物种的另一个页面的链接。每个物种都由一个唯一的 ID 标识,这就是我想要的信息。
例如,如果我在搜索框“科学名称”中输入“Mnais mneme”,页面会显示一个包含该物种的表格和链接(https://www.afcd.gov.hk/english/conservation/hkbiodiversity/database/popup_record .php?id=781&lang=en ) 附加到它的名字会出现。“781”将是物种 ID。
我想将此链接复制到我的 xlsm 的 B 列中并在 Excel 中提取 ID:
Sub SearchBot()
'dimension (declare or set aside memory for) our variables
Dim objIE As InternetExplorer 'special object variable representing the IE browser
'link will be the <a> carrying the href with the species id
Dim link As HTMLAnchorElement
'define y as interger counter
Dim y As Integer
'initiating a new instance of Internet Explorer and assigning it to objIE
Set objIE = New InternetExplorer
'make IE browser visible (False would allow IE to run in the background)
objIE.Visible = True
'navigate IE to this web page
objIE.navigate "https://www.afcd.gov.hk/english/conservation/hkbiodiversity/database/search.php"
'wait here for a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
objIE.document.getElementById("s1").Click
'in the search box put cell "A2" value
objIE.document.all.Item("scientific_name").Value = Sheets("Sheet1").Range("A2").Value
'click the 'Search' button
objIE.document.getElementsByClassName("btn_3")(1).Click
'wait again for the browser
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'select the species name link
Set link = objIE.document.getElementsByTagName("td")(4).getElementsByTagName ("a")(0)
y = 2
'print the link to column B in Sheet1
Sheets("Sheet1").Range("B" & y).Value = link.href
End Sub
调试显示
运行时错误 91
在最后一行停止时:
Sheets("Sheet1").Range("B" & y).Value = link.href
将链接设置为 HTMLAnchorElement 是否有问题?我尝试将其设置为 Object 但仍然出现错误。
解决方案
这是一些使用 Web 请求来查找您感兴趣的数据的代码。我查看了该页面,并且似乎复选框SpeciesID
也包含该复选框,因此,我使用该控件的名称来查找输入的值。
代码
Public Function GetSpeciesID(ScientificName As String) As String
Dim requestURL As String
Const InvalidValue As String = "-1"
'If the Scientific Name is blank, return a default value
If (Trim$(ScientificName) = vbNullString) Then
GetSpeciesID = InvalidValue
Exit Function
End If
requestURL = "https://www.afcd.gov.hk/english/conservation/hkbiodiversity/database/doSearch.php?" & _
"entity_id=0&family_name=&scientific_name=" & WorksheetFunction.EncodeURL(ScientificName) & _
"&common_name=&chinese_name=&hk_protection_status_val=&chinared_status_val=&iucn_status_val="
With CreateObject("MSXML2.ServerXMLHTTP.6.0")
.Open "GET", requestURL
.send
Dim html As Object: Set html = CreateObject("htmlfile")
html.body.innerhtml = .responseText
End With
GetSpeciesID = html.getElementsByName("check")(0).Value
End Function
'Run this method
Public Sub Runner()
Debug.Print GetSpeciesID("Mnais mneme")
End Sub
推荐阅读
- ios - 如何在 iOS 13 中更改 tabBar 的框架?
- sql - 如何在 postgresql 中将格式传递给 to_timestamp?
- c# - webClient.OpenRead 图片扩展webp问题
- python - 根据熊猫数据框中的两列组合单元格值
- qt - 错误:无法编译最小程序。工具链或 QMakeSpec 已损坏。在构建 ParaView 以执行 Qt 自定义应用程序时
- swift - 如何检查操作是否被取消?
- vba - 标签不会消失
- hyperledger-fabric - 作曲家卡导入错误返回“找不到所需文件:connection.json”
- c# - Linq Skip and Take 函数使 EF 核心中的导航属性为空
- eclipse - 在 PATH 中找不到程序“make”,Eclipse ESP8266