用于导航网页和下载 CSV 的 VBA 脚本

Question

我正在寻求帮助以开发在 excel 中运行的 VBA 脚本。

在this 网站，可以为每个基金下载 CSV 文件。我要的 VBA 脚本将：

• 导航到上述网址
• 将资金类型设置为“全部”
• 将可用性设置为“全部”
• 从下拉列表中选择基金提供者
• 点击“过滤资金”按钮
• 点击“下载数据 (.csv)”按钮

需要对“资金提供者”下拉菜单中的每个项目重复此过程。

我在使用 IE 浏览网站方面经验不足，因此不胜感激。我现有的代码如下。它允许我访问 Fund Type 按钮，但我不确定如何更改它的值。

Option Explicit
Sub FidelityCSV()
    ' Create Internet Explorer object.
    Dim BaseURL As String
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")

    BaseURL = "https://www.fidelity.co.uk/fund-prices/"
    IE.Visible = True     ' Keep this hidden.
    IE.navigate BaseURL

    Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
        DoEvents
    Loop

    'Wait for it to really finish loading
    Application.Wait (Now + TimeValue("0:00:15"))

    Dim oHEle 'As IHTMLElementCollection
    Dim oHDoc As HTMLDocument

    Set oHDoc = IE.document

    Set oHEle = oHDoc.getElementById("fund_type")

    ' Clean up.
    IE.Quit
    Set IE = Nothing
    Set oHEle = Nothing
    Set oHDoc = Nothing
End Sub

Answer 1

XMLHTTP 请求：

您可以避免使用浏览器并模仿页面 POST 请求

Option Explicit
Public Sub GetData()
    Dim sResponse As String, body As String
    body = "appliedFilters=*/INVESTMENT_COMPANY/NAME|Allianz"
    body = body & "&idolQueryParam=fund_prices"
    body = body & "&orderedUIFields=officialName,priceUpdatedDate,buy,sell,priceChange,currency"
    body = body & "&mode=all"
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    With http
        .Open "POST", "https://www.fidelity.co.uk/product/securities/service/funds/download-funds", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send body
        With CreateObject("ADODB.Stream")
            .Open
            .Type = 1
            .write http.responseBody
            .SaveToFile "C:\Users\User\Desktop\Data.csv", 2 
            .Close
        End With
    End With
End Sub

---

使用 Internet Explorer：

以下内容向您展示了如何执行每个操作并为一个提供者设置。应该清楚如何设置循环来选择其他提供者。请参阅 StackOverflow 上有关单击“保存/打开”对话框的许多答案。

Option Explicit    
Public Sub Download()
    Dim ie As New InternetExplorer
    With ie
        .Visible = True
        .Navigate2 "https://www.fidelity.co.uk/fund-prices/"

        While .Busy Or .readyState < 4: DoEvents: Wend

        On Error Resume Next
        .document.querySelector(".button--accept").Click '<==Cookies
        On Error GoTo 0

        With .document
            .querySelector("#fund_type").selectedIndex = 0 '<== All.
            .querySelector("#allfundsAvailability").Click '<== All
            .querySelector("#fund_provider [value='AXA']").Selected = True '<== Select provider
            .querySelector("#filterBtn").Click '<== Apply filter
            .querySelector("#ofPrint").Click ' <==Download
        End With
        Stop
        '.Quit
    End With
End Sub