vba - Excel VBA:自动单击并从网站打开文件
问题描述
感谢Qharr,我已经成功地在网站上执行了自动搜索。(我之前的问题: Excel VBA:无法在网站上执行自动搜索)我还有一个关于下一步的问题:我总是想点击之后出现的第一个链接单击搜索按钮,然后打开文件以提取某些数据。有没有办法做到这一点?谢谢!
我目前拥有的代码:
Option Explicit
Sub Searchstockcode()
Dim SearchString As String, SearchBox As Object, SearchButton As Object, ie As Object
SearchString = "2828"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://www.hkexnews.hk/listedco/listconews/advancedsearch/search_active_main.aspx"
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Set SearchBox = ie.document.getElementById("ctl00_txt_stock_code")
SearchBox.Value = SearchString
Set SearchButton = ie.document.querySelector("[src*='/image/search.gif']")
SearchButton.Click
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
'Click the first result
Set TargetFile = ie.document.getElementById("ctl00_gvMain_ctl02_hlTitle")
TargetFile.Click
'Here I would like to open the file in excel, but I am stuck at the "save as" pop up.
'As long as the file can be opened, I should be able to complete the data extraction with my own codes.
ie.Quit
End Sub
解决方案
您可以提取文件下载和二进制文件下载的 URL。在下面的示例中,该文件存储在一个变量中wb
以供以后使用。
在下文中,文件下载链接通过 TargetFile.href 提取并传递给执行 ADODB 二进制下载的函数。您还可以将下载的 URL 传递给 URLMon,如我在此处的回答中所示。
Option Explicit
Public Sub Searchstockcode()
Dim SearchString As String, SearchBox As Object, SearchButton As Object, ie As Object
SearchString = "2828"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://www.hkexnews.hk/listedco/listconews/advancedsearch/search_active_main.aspx"
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Set SearchBox = ie.document.getElementById("ctl00_txt_stock_code")
SearchBox.Value = SearchString
Set SearchButton = ie.document.querySelector("[src*='/image/search.gif']")
SearchButton.Click
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Dim TargetFile As Object
Set TargetFile = ie.document.getElementById("ctl00_gvMain_ctl02_hlTitle")
On Error Resume Next
Dim wb As Workbook
Set wb = Workbooks.Open(DownloadFile("C:\Users\User\Desktop\", TargetFile.href)) '< Replace with your download path here ending in "\"
On Error GoTo 0
'Other stuff
ie.Quit
End Sub
Public Function DownloadFile(ByVal downloadFolder As String, ByVal downloadURL As String) As String
Dim http As Object , tempArr As Variant
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "GET", downloadURL, False
http.send
On Error GoTo errhand
With CreateObject("ADODB.Stream")
.Open
.Type = 1
.write http.responseBody
tempArr = Split(downloadURL, "/")
tempArr = tempArr(UBound(tempArr))
.SaveToFile downloadFolder & tempArr, 2 '< "/" on enter of downloadFolder. 2 for overwrite which is Ok if no file modifications.
.Close
End With
DownloadFile = downloadFolder & tempArr
Exit Function
errhand:
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
MsgBox "Download failed"
End If
DownloadFile = vbNullString
End Function
URLMon 版本:
Option Explicit
Public Const BINDF_GETNEWESTVERSION As Long = &H10
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
#End If
Public Sub Searchstockcode()
Dim SearchString As String, SearchBox As Object, SearchButton As Object, ie As Object
SearchString = "2828"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://www.hkexnews.hk/listedco/listconews/advancedsearch/search_active_main.aspx"
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Set SearchBox = ie.document.getElementById("ctl00_txt_stock_code")
SearchBox.Value = SearchString
Set SearchButton = ie.document.querySelector("[src*='/image/search.gif']")
SearchButton.Click
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
Dim TargetFile As Object
Set TargetFile = ie.document.getElementById("ctl00_gvMain_ctl02_hlTitle")
On Error Resume Next
Dim wb As Workbook
Set wb = Workbooks.Open(downloadFile("C:\Users\User\Desktop\", TargetFile.href)) '< Replace with your download path here ending in "\"
On Error GoTo 0
'Other stuff
ie.Quit
End Sub
Public Function downloadFile(ByVal downloadFolder As String, ByVal URL As String) As String
Dim tempArr As Variant, ret As Long
tempArr = Split(URL, "/")
tempArr = tempArr(UBound(tempArr))
ret = URLDownloadToFile(0, URL, downloadFolder & tempArr, BINDF_GETNEWESTVERSION, 0)
downloadFile = downloadFolder & tempArr
End Function
推荐阅读
- json - 无法在 Swift 中解析 JSON。"预期解码字典
但找到了一个数组。” - r - 如何将图像添加到 Rmarkdown 文件中的所有页面?
- snmp - 连接到调制解调器的设备上的 SNMP Walk
- jupyter-notebook - 驱动器用完空间后jupyter笔记本列表错误
- reactjs - TypeScript 错误地推断 React 中的变量类型...?
- javascript - chrome 扩展适用于刷新/陆地,但不适用于“内部导航”
- javascript - 如何使用 AJAX GET 请求发送 JSON
- mongodb - 使用 MongoDB 对文档进行分组
- python - Python - 文件处理,for循环
- checkstyle - 如何在 checkstyle 上配置抑制 ParameterNumber?