Serving the Quantitative Finance Community

 
ilscot
Topic Author
Posts: 4
Joined: August 22nd, 2020, 10:49 pm

VBA cycle web queries through URLs

December 1st, 2020, 5:23 pm

so, this cannot be a new idea and I am certain I am missing something trival...

I wish to cycle through several urls and grab specific tables from each page (in Excel)
  I can do this manually in Excel using the Data=>Web Query tool
  I can record a macro to do this
  I can change the string referring to a specific URL
Yet the connection fails to establish a query

Sub Macro1()
'
' Macro1 Macro
'
' *************************
'**************************
' The goal is to cycle through 40 or so URLs - with specific table ID's on each
' Create a connection, load the table(s) and then manipulate the data
' I don't need or even want to create new sheets every time the macro runs
' **************************
' **************************

    ActiveWorkbook.Queries.Add Name:= _
        "This Week's Major U S  Economic Reports & Fed Speakers", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://www.marketwatch.com/economy-politics/calendar""))," & Chr(13) & "" & Chr(10) & "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Time (ET)"", type text}, {""Report"", type text}, {""Period"", type text}, {""Actual"", type number}, {""Median Forecast"", type text}, {""Previous"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #" & _
        """Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""This Week's Major U S  Economic Reports & Fed Speakers"";Exten" _
        , "ded Properties="""""), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array( _
        "SELECT * FROM [This Week's Major U S  Economic Reports & Fed Speakers]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = _
        "This_Week_s_Major_U_S__Economic_Reports___Fed_Speakers"
        .Refresh BackgroundQuery:=False
    End With

    Range("I1").Select
    ActiveCell.FormulaR1C1 = "End of First Load"
    Range("I2").Select

    ActiveWorkbook.Queries.Add Name:="Table 0 (2)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://finance.yahoo.com/calendar/economic""))," & Chr(13) & "" & Chr(10) & "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Event"", type text}, {""Country"", type text}, {""Event Time"", type text}, {""For"", type text}, {""Actual"", type text}, {""Market Expectation"", type text}, {""Prior to This"", type " & _
        "number}, {""Revised from"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0 (2)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0 (2)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_0__2"
        .Refresh BackgroundQuery:=False
    End With

    Range("K2").Select
    ActiveCell.FormulaR1C1 = "end of second load"
    Range("K3").Select

End Sub
Attachments
URL_Macro.txt
(3.62 KiB) Downloaded 197 times