Question

感谢Qharr，我已成功在网站上执行了自动搜索。（我之前的问题： Excel VBA: Cannot perform auto search on website）关于下一步，我还有另一个问题：我总是想单击单击搜索按钮后出现的第一个链接，然后打开文件以提取某些数据。有没有办法做到这一点？谢谢！

我目前拥有的代码：

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

Answer 1

您可以提取文件下载和二进制文件下载的URL。在下面的示例中，文件存储在变量wb中，以备后用。

以下，通过TargetFile.href提取了文件下载链接，并将其传递给执行ADODB二进制下载的函数。您还可以按照我的答案here所示将要下载的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

Excel VBA：自动单击并从网站打开文件

1 个答案: