Question

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

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

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

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

我在使用IE导航网站方面经验很少，因此希望获得任何指导。我现有的代码如下。它使我可以访问“基金类型”按钮，但不确定如何更改其值。

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

VBA脚本可浏览网页并下载CSV

1 个答案: