I want to “get” a CSV file from a webpage in VBA using this code (or similar):
Dim sHTTPResponse As String
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "POST", sURL, False
objHTTP.Send ""
sHTTPResponse = objHTTP.responseText
This code works for a number of websites and pages which do NOT return a CSV file.
But it fails with “access is denied” when the URL points to a Google spreadsheet, like for example:
“https://docs.google.com/spreadsheets/d/e/2PACX-1vRE5XeARs0iTKboEAfnVbdr-XPq0SUltZ1YGNxFtFcg4Zl6CTjGwk3pg6sUti4wmC0T0TXZsidZCEDP/pub?gid=0&single=true&output=csv”
Is it trying to write to my disk when it says “access is denied” ? I am only interested in retrieving the file as text in a text string.
1
You can use my function DownloadFile found in module Internet.bas at Github:
VBA.PictureUrl.
Url = "https://docs.google.com/spreadsheets/d/e/2PACX-1vRE5XeARs0iTKboEAfnVbdr-XPq0SUltZ1YGNxFtFcg4Zl6CTjGwk3pg6sUti4wmC0T0TXZsidZCEDP/pub?gid=0&single=true&output=csv"
Result = DownloadFile(Url, "D:Testyourfile.csv")
The output parameter &output=csv is causing the error. Removing the parameter returns HTML as text. You could convert the text to an html document extract the table data but I think Power Query is the tool for the job.
sURL = "https://docs.google.com/spreadsheets/d/e/2PACX-1vRE5XeARs0iTKboEAfnVbdr-XPq0SUltZ1YGNxFtFcg4Zl6CTjGwk3pg6sUti4wmC0T0TXZsidZCEDP/pub?gid=0&single=true"
Power Query
The code below will add a query table that automatically refreshes every 5 minutes. I set it to 5 minutes because the GooGleFinance Spreadsheet says that it is updated every 5 minutes.
Sub CreateGoogleFinanceTable()
Const QueryName As String = "Google-Finance"
Const RefreshPeriod As Long = 5
On Error Resume Next
ActiveWorkbook.Queries(QueryName).Delete
On Error GoTo 0
ActiveWorkbook.Queries.Add Name:=QueryName, Formula:= _
"let" & Chr(13) & Chr(10) & _
" Source = Web.Page(Web.Contents(""https://docs.google.com/spreadsheets/d/e/2PACX-1vRE5XeARs0iTKboEAfnVbdr-XPq0SUltZ1YGNxFtFcg4Zl6CTjGwk3pg6sUti4wmC0T0TXZsidZCEDP/pub?gid=0&single=true""))," & Chr(13) & Chr(10) & _
" Data0 = Source{0}[Data]," & Chr(13) & Chr(10) & _
" #""Changed Type"" = Table.TransformColumnTypes(Data0, {" & Chr(13) & Chr(10) & _
" {""Column1"", type text}, {""Column2"", Int64.Type}, {""Column3"", type text}," & Chr(13) & Chr(10) & _
" {""Column4"", type text}, {""Column5"", type text}, {""Column6"", type text}," & Chr(13) & Chr(10) & _
" {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type text}," & Chr(13) & Chr(10) & _
" {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}" & Chr(13) & Chr(10) & _
" })," & Chr(13) & Chr(10) & _
" #""Promoted Headers"" = Table.PromoteHeaders(#""Changed Type"", [PromoteAllScalars=true])," & Chr(13) & Chr(10) & _
" #""Changed Type1"" = Table.TransformColumnTypes(#""Promoted Headers"", {" & Chr(13) & Chr(10) & _
" {""Google"", type text}, {""Reuters RIC"", type text}, {""Spot"", type number}," & Chr(13) & Chr(10) & _
" {""Close"", type number}, {""CCY"", type text}, {""Shares"", Int64.Type}," & Chr(13) & Chr(10) & _
" {""High"", type number}, {""Low"", type number}, {""LastTrade"", type datetime}," & Chr(13) & Chr(10) & _
" {""Name"", type text}" & Chr(13) & Chr(10) & _
" })," & Chr(13) & Chr(10) & _
" #""Reordered Columns"" = Table.ReorderColumns(#""Changed Type1"", {" & Chr(13) & Chr(10) & _
" ""Google"", ""Reuters RIC"", ""Spot"", ""Close"", ""CCY"", ""Shares"", ""High"", ""Low"", ""LastTrade"", ""Name""" & Chr(13) & Chr(10) & _
" })," & Chr(13) & Chr(10) & _
" #""Removed Columns"" = Table.RemoveColumns(#""Reordered Columns"", {""1"", """"})" & Chr(13) & Chr(10) & _
"in" & Chr(13) & Chr(10) & _
" #""Removed Columns"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 0]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = RefreshPeriod
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub