简体   繁体   中英

VBA. How to download text instead of .csv from webpage

The following macro downloads data (prices, volume…) from Yahoo Finance for a given stock and a range of dates. The steps are:

  1. Compose URL
  2. Download and save csv file
  3. Import csv to a string
  4. Parse the string to Excel
  5. Delete csv file
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

I am not familiar with the "Microsoft.XMLHTTP" and "ADODB.Stream" objects. I managed to make the macro work by looking on the internet.

I was wondering if, for the sake of simplicity -and maybe efficiency- it would be possible to skip saving the csv and instead downloading the string right away, so I tried merging the steps 2 and 3 into this:

'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

I get the error

Operation not allowed in this context

in this line

.Write WinHttpReq.responseBody

Is it possible to skip saving, importing and deleting the csv file?

If so, how?

Thanks in advance.


Update

I solved it with this code. I will have to check if it actually runs faster. Also I am missing things such as specifying the character typoe (utf-8), but it seems to be working in this case.

'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

You can open the csv directly in excel using the 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)

The importing of the CSV data could be done with Power Query.

  • You would go to the Data tab and choose to import data from the web.

在此处输入图像描述

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

在此处输入图像描述

This will execute without saving the CSV.

And to execute this with VBA, just record the macro while performing the steps above and you'll have the code needed to reproduce this in VBA.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM