VBA. Как загрузить текст вместо .csv с веб-страницы

Question

Следующий макрос загружает данные (цены, объем…) из Yahoo Finance для данной акции и диапазона дат. Шаги:

1. Составить URL
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». Мне удалось заставить макрос работать, посмотрев на inte rnet.

. Мне было интересно, можно ли для простоты - и, возможно, эффективности - пропустить сохранение 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

Вы можете открыть CSV прямо в Excel, используя URL:

    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.

• Вы должны go перейти на вкладку «Данные» и выбрать импорт данных из Интернета.

• Enter the URL of the CSV, press OK and then Load.

введите описание изображения здесь

Это будет выполняться без сохранения CSV.

И чтобы выполнить это с помощью VBA, просто запишите макрос при выполнении вышеуказанных шагов, и у вас будет код, необходимый для воспроизведения этого в VBA.