Excel VBA:自动单击并从网站打开文件 [英] Excel VBA: auto click and open file from website

问题描述

感谢Qharr，我已经成功地在网站上执行了自动搜索.(我之前的问题: Excel VBA:无法在网站上执行自动搜索) 关于下一步，我还有另一个问题:我总是想单击单击搜索按钮后出现的第一个链接，然后打开文件以提取某些数据.有没有办法做到这一点?谢谢！

Thanks to Qharr, I have successfully performed auto search on the website.(My previous question: Excel VBA: Cannot perform auto search on website) I have another question concerning the next step: I would always like to click the first link that appears after clicking the search button, and open the file in order to extract certain data. Is there any ways to do that? Thanks!

我目前拥有的代码:

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中供以后使用.

You can extract the URL for the file download and binary file download. In the example below, the file is stored in a variable wb for later use.

以下，通过TargetFile.href提取了文件下载链接，并将其传递给执行ADODB二进制下载的函数.您也可以在我的答案此处中显示将要下载的URL传递到URLMon.

In the following the filedownload link is extracted via TargetFile.href and passed to a function to perform ADODB binary download. You could also pass the URL for download to URLMon as shown in my answer here.

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版本:

---

URLMon version:

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:自动单击并从网站打开文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！