从链接下载 .csv

Question

I'm trying to build a VBA code which has as input this calendar:
https://www.fxstreet.com/economic-calendar#

In this link there exists the option to download it in format .csv. For example this was the link of the download. 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

I want to define a code in VBA based on it, changing that start date and end date according to my input in cell "A1" and "A2", but it's impossible due to the structure of the link (it doesn't finish in .csv). If you go to section of downloads in your browser, and press the link, it won't download again, instead a message of error will appear. It just works when opening the first link and selecting the option to download- so, I can´t build a structure in VBA based on it.

Does there exist a way that VBA can open the link and then "select" the option to download, or do you have another idea to download it using VBA?

Answer 1

I don't see any kind of CSV file in the link you posted, but this is one way you could do it with VBA.

Sub Download()

Dim myURL As String

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

Dim WinHttpReq As Object
Dim ostream 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

Not great due to sendkeys but does download the CSV for the current period. Setting dates seems to be a lot harder. Whilst entering custom dates ranges and clicking apply is easy, the values don't appear to be retained (manually or through code!). The only way values seem to be retained is if you actually make selections on the calendar itself. That then becomes a lot more finicky. I could address that in a new question if required.

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

---

References:

1. VBE > Tools > References and add a reference to Microsoft Internet Controls

Answer 3

Adjust the 'iTable' variable to the table number that you want to import (ie, 1, 2, 3, etc)

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