Search code examples
htmlexcelvbaexcel-automation

VBA Application-defined error Querying Data from a website


I am trying to query data from the website listed below in VBA. The query is resulting in a 1004 error--Application-defined or object-defined error.

This is the website: https://www.troa.net/tis/?interval=instant&type=2&cat=1&did=18&sid28=150027&sid45=152418&format=htmls&sdate=05-Mar-2023&edate=09-Mar-2023

Here is the code:

Sub QueryHourlyFlowData()
'This sub will retrieve the data from the websites containing the forecast data for
'Farad Ft Churchill and Tahoe using a web query.

    'Define the Variables that are used in this macro
    Dim StartDate As Date, EndDate As Date
    Dim sDate As String, eDate As String, meURL As String
    Dim ws As Workbook
    Dim TraceCount As Long

    Set ws = ActiveWorkbook
    ws.Activate
    Sheets("HourlyFlow").Select

    Cells.ClearContents
    StartDate = Range("StartDate")
    sDate = Format(StartDate - 3, "dd-Mmm-yyyy")
    eDate = Format(StartDate, "dd-Mmm-yyyy")
    
    'Creating the URL that will be used to look up the data
    meURL = "https://www.troa.net/tis/?interval=instant&type=2&cat=1&did=18&sid28=150027&sid45=152418&format=htmls&sdate=" & sDate & "&edate=" & eDate

    With ActiveSheet.QueryTables.Add(Connection:= _
        meURL, Destination:=Range("A1"))
        .Name = "/html/body/table/tbody/tr[3]"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

Any ideas what is causing the error?


Solution

  • Try adding the prefix "URL;" to your Connection argument, for example...

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & meURL, Destination:=Range("A1"))
        'etc
        '
        '
    End With