簡體   English   中英

從鏈接下載 .csv

[英]Download .csv from a link

我正在嘗試構建一個 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%2CCount

我想根據它在 VBA 中定義一個代碼,根據我在單元格“A1”和“A2”中的輸入更改開始日期和結束日期,但由於鏈接的結構,這是不可能的(它沒有在.csv)。 如果您在瀏覽器中轉到下載部分,然后按鏈接,它將不會再次下載,而是會出現一條錯誤消息。 它只在打開第一個鏈接並選擇下載選項時起作用 - 所以,我無法基於它在 VBA 中構建結構。

是否存在 VBA 可以打開鏈接然后“選擇”下載選項的方法,或者您有其他想法使用 VBA 下載它嗎?

我在您發布的鏈接中沒有看到任何類型的 CSV 文件,但這是您可以使用 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

由於 sendkeys 不是很好,但確實下載了當前時期的 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

參考:

  1. VBE > Tools > References 並添加對Microsoft Internet Controls的引用

將“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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM