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

Posted 2023-02-23

【中文标题】Excel VBA：自动单击并从网站打开文件

【英文标题】：Excel VBA: auto click and open file from website

【发布时间】：2019-02-14 03:29:34

【问题描述】：

感谢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

【问题讨论】：

请以您的问题不包含在代码块内的注释中的方式进行编辑。

【参考方案1】：

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

在下面，文件下载链接通过 TargetFile.href 提取并传递给一个函数以执行 ADODB 二进制下载。您还可以将下载的 URL 传递给 URLMon，如我的回答 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 版本：

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

【讨论】：

感谢 QHarr！但是我在“Dim http As New WinHttp.WinHttpRequest”遇到了一个错误。 （编译错误：未定义用户定义类型）。我有机会解决这个问题吗？

是的。对不起。 VBE > 工具 > 参考和为 WinHTTP 添加参考或使用后期绑定的两种方法之一。试试后期绑定的编辑版本。

几件事....1) 不涉及点击 2) 除了添加您自己的下载文件夹路径之外，您是否完全按照上述方式运行我的代码？ 3) 按 Ctrl + G 打开即时窗口...那里有打印错误信息吗？您是否收到提示文件下载失败的消息框？

您拥有该文件的文件夹路径，因此您可能可以使用 kill 命令。例如。 ***.com/questions/67835/deleting-a-file-in-vba

非常感谢！你救了我的命！