VBA。如何从网页下载文本而不是 .csv

Question

以下宏从 Yahoo Finance 下载给定股票和一系列日期的数据（价格、交易量……）。 步骤是：

1. 撰写网址
2. 下载并保存 csv 文件
3. 将 csv 导入字符串
4. 将字符串解析为 Excel
5. 删除 csv 文件

Sub main()
Dim dirlocal As String
Dim ticker As String
Dim date1 As Long, date2 As Long

'Path of the folder I want to download the data in
dirlocal = Application.ActiveWorkbook.path

ticker = "KO" 'The CocaCola Company
date1 = 43831 '01/01/2020
date2 = 43861 '31/01/2020

Call download_CSV(dirlocal, ticker, date1, date2)
End Sub

Sub download_CSV(dirlocal As String, ticker As String, date1 As Long, date2 As Long)

'Create excel file that will contain the downloaded data
Dim Dir_xls As StringIT
Dir_xls = dirlocal & "\" & ticker & ".xlsx"
Dim wb As Workbook
Set wb = Workbooks.Add
wb.SaveAs Dir_xls
    
'DOWNLOAD DATA. -1- Compose URL

Dim URL As String
Dim dat1 As Long, dat2 As Long
    'I need to "scale" the dates for the web page to understand me:
dat1 = (date1 - 25569) * 86400
dat2 = (date2 - 25569) * 86400
URL = "https://query1.finance.yahoo.com/v7/finance/download/" & ticker & "?period1=" & dat1 & "&period2=" & dat2 & "&interval=1d&events=history"

'DOWNLOAD DATA. -2- Save csv

Dim Dir_csv As String
Dir_csv = dirlocal & "\" & ticker & ".csv"

Dim WinHttpReq As Object
Dim ostream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set ostream = CreateObject("ADODB.Stream")
    ostream.Open
    ostream.Type = 1
    ostream.Write WinHttpReq.responseBody
    ostream.SaveToFile Dir_csv, 2
    ostream.Close
Else
    MsgBox (WinHttpReq.Status & " : Not found")
End If
    
'DOWNLOAD DATA. -3- Import csv
    
Dim strText As String
'Read utf-8 file to strText variable
With CreateObject("ADODB.Stream")
    .Open
    .Type = 1  ' Private Const adTypeBinary = 1
    .LoadFromFile Dir_csv
    .Type = 2  ' Private Const adTypeText = 2
    .Charset = "utf-8"
    strText = .ReadText(-1)  ' Private Const adReadAll = -1
End With

'DOWNLOAD DATA. -4- Parse strText to worksheet
Dim ws As Worksheet 'Worksheet I want to place the data in
Set ws = wb.Worksheets(1)
Dim introw As Long
Dim strLine As Variant
introw = 1
Application.DisplayAlerts = False
For Each strLine In Split(strText, Chr(10))
    If strLine <> "" Then
        With ws
            .Cells(introw, 1) = strLine
            .Cells(introw, 1).TextToColumns Destination:=Cells(introw, 1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=False
        End With
        'Ignore line if price is "null"
        If ws.Cells(introw, 5) <> "null" Then
            introw = introw + 1
        End If
    End If
Next strLine

'Delete csv file
Kill Dir_csv
'Save excel file
wb.Save
wb.Close
End Sub

我不熟悉“Microsoft.XMLHTTP”和“ADODB.Stream”对象。我设法通过查看互联网使宏工作。

我想知道，为了简单起见——也许是为了提高效率——是否可以跳过保存 csv 而直接下载字符串，所以我尝试将步骤 2 和 3 合并到此：

'DOWNLOAD DATA. -2&3- Get String

Dim strText As String 'Aimed string

Dim WinHttpReq As Object
Dim ostream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set ostream = CreateObject("ADODB.Stream")
    With ostream
        .Open
        .Write WinHttpReq.responseBody
        .Type = 2  ' Private Const adTypeText = 2
        .Charset = "utf-8"
        strText = .ReadText(-1) ' Private Const adReadAll = -1
    End With
Else
    MsgBox (WinHttpReq.Status & " : Not found")
End If

我得到了错误

在此上下文中不允许操作

在这一行

.Write WinHttpReq.responseBody

是否可以跳过保存、导入和删除csv文件？

如果有，怎么做？

提前致谢。

---

更新

我用这段代码解决了这个问题。我将不得不检查它是否真的运行得更快。我还遗漏了诸如指定字符拼写错误（utf-8）之类的东西，但它似乎在这种情况下有效。

'DOWNLOAD DATA. -2&3- Get String

Dim strText As String 'Aimed string

Dim WinHttpReq As Object
Dim ostream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    strText = WinHttpReq.responseText
Else
    MsgBox (WinHttpReq.Status & " : Not found")
End If

Answer 1

您可以使用 URL 直接在 excel 中打开 csv：

    Dim URL, wb
    URL = "https://query1.finance.yahoo.com/v7/finance/download/AAPL?" & _
         "period1=1592352000&period2=1596672000&interval=1d&events=history"
    
    Set wb = Workbooks.Open(URL)

Answer 2

CSV 数据的导入可以通过 Power Query 完成。

• 您将转到“数据”选项卡并选择从网络导入数据。

• 输入 CSV 的 URL，按 OK，然后按 Load。

这将在不保存 CSV 的情况下执行。

要使用 VBA 执行此操作，只需在执行上述步骤时记录宏，您将拥有在 VBA 中重现此操作所需的代码。