VBA 和 html 新手在这里,这是我在网站上的第一篇文章。
我正在尝试使用来自本网站的信息自动更新我的物种数据库: https://www.afcd.gov.hk/english/conservation/hkbiodiversity/database/search.php
所以我有一个 xlsm 包含我对 A 列感兴趣的物种列表,并在网站的搜索引擎中搜索每个物种,这会导致一个页面显示指向另一个专用于该特定物种的页面的链接.每个物种都有唯一的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 但错误仍然出现。我是 VBA 和 HTML 的新手,并且已经坚持了几天......在解决这个问题之前无法继续编写循环......如果有人能提供帮助,我将不胜感激!
干杯, 原因
答案 0 :(得分:1)
这里有一些代码使用 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