Question

我正在尝试构建一个vba代码，该代码已将此日历作为输入：

https://www.fxstreet.com/economic-calendar#

在此链接中存在以.csv格式下载的选项。例如，这是下载链接。 https://calendar.fxstreet.com/eventdate/?f=csv&v=2&timezone=Central+Standard+Time&rows=&view=range&start=20180909&end=20180915&countrycode=US&volatility=0&culture=en&columns=CountryCurrency%2CCountdown

我想基于它在VBA中定义一个代码，根据我在单元格“ A1”和“ A2”中的输入来更改开始日期和结束日期，但是由于链接的结构是不可能的（它不会（请在.csv中完成），实际上，如果您在浏览器中转至下载部分，然后按链接，它将不会再次下载，而是会出现错误消息-更确切地说，当打开第一个链接，然后选择要下载的选项-因此，我无法基于VBA在VBA中构建结构。 VBA是否存在打开链接然后“选择”下载选项的方式，还是您有其他想法使用vba来下载链接？

谢谢您的时间！!!!

Answer 1

在您发布的链接中看不到任何CSV文件，但这是使用VBA的一种方式。

Sub Download()

Dim myURL As String

myURL = "http://www.asx.com.au/data/options_code_list.csv"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send
myURL = WinHttpReq.ResponseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.ResponseBody
        oStream.SaveToFile ("C:\your_path_here\file.csv")
        oStream.Close
    End If

End Sub

Answer 2

由于使用了sendkey，所以效果不佳，但是确实下载了当前时段的CSV文件。设定日期似乎要困难得多。尽管输入自定义日期范围并单击“应用”很容易，但这些值似乎并没有保留（手动或通过代码！）。似乎保留值的唯一方法是在日历本身上进行选择。然后，这变得更加挑剔。如果需要，我可以在一个新问题中解决这个问题。

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, calendar As Object, t As Date
    Const WAIT_TIME_SECS As Long = 10
    With IE
        .Visible = True
        .navigate "https://www.fxstreet.com/economic-calendar#"

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

        t = Timer
        Do
            DoEvents
            If Timer - t > WAIT_TIME_SECS Then Exit Do
            On Error Resume Next
            Set calendar = .document.querySelector(".fa.fa-calendar")
            On Error GoTo 0
        Loop While calendar Is Nothing

        If calendar Is Nothing Then Exit Sub

        .document.querySelector("[fxs_csv]").Click
        With Application
            .Wait Now + TimeSerial(0, 0, 2)
            .SendKeys "%{S}"
            .Wait Now + TimeSerial(0, 0, 5)
        End With
        .Quit
    End With
End Sub

参考：

VBE>工具>参考，并添加对 Microsoft Internet Controls

Answer 3

将“ iTable”变量调整为要导入的表号（即1、2、3等）

Sub HTML_Table_To_Excel()

Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object

'Replace the URL of the webpage that you want to download
'Web_URL = "https://en.wikipedia.org/wiki/List_of_U.S._states_and_territories_by_population"
Web_URL = "https://www.fxstreet.com/economic-calendar"

'Create HTMLFile Object
Set HTML_Content = CreateObject("htmlfile")

'Get the WebPage Content to HTMLFile Object
With CreateObject("msxml2.xmlhttp")
.Open "GET", Web_URL, False
.send
HTML_Content.body.innerHTML = .responseText 'this is the highlighted part for the error
End With
Column_Num_To_Start = 1
iRow = 1
iCol = 1
iTable = 1

'Loop Through Each Table and Download it to Excel in Proper Format
For Each Tab1 In HTML_Content.getElementsByTagName("table")
    With HTML_Content.getElementsByTagName("table")(iTable)
        For Each Tr In .Rows
            For Each Td In Tr.Cells
            Worksheets("Sheet1").Cells(iRow, iCol).Select
            Worksheets("Sheet1").Cells(iRow, iCol) = Td.innerText
            iCol = iCol + 1
            Next Td
        iCol = Column_Num_To_Start
        iRow = iRow + 1
        Next Tr
    End With

Next Tab1

MsgBox "Process Completed"
End Sub

VBA：从链接下载.CSV

3 个答案: