Scraping a table from a website, VBA code needs to be updated, running into issues

[Kernkraft4000]

Hello,

I am certainly not programming literate or anywhere close to where I need to be. I have an old excel macro file that I use to scrape weekly Canadian refining data and updated the website URL, but am still running into problems that I have tried to trouble shoot with ChatGPT4, but am not really getting anywhere. I am on the Brave browser and not running a VPN when I attempt to run the macro and am getting the following error with the following line of code highlighted. I can confirm the target cell, format of the date entry, etc.

Any help would be greatly appreciated. Thank you.

Run-time error '1004' Application-defined or object-defined error --> pinpointing to: With ws.QueryTables.Add(Connection:=rdate2, Destination:=Range("$A$1"))

https://apps.cer-rec.gc.ca/WCR/WCRPublicRegionalReport.aspx

Sub importcan()
Dim rdate, rdate2 As String
Dim ont, que, west As Integer
Set ws = ThisWorkbook.Sheets("RUN")

rdate = Cells(2, 2).Value
rdate2 = "https://apps.cer-rec.gc.ca/WCR/WCRPublicRegionalReport.aspx?pd=" & rdate & "&lang=English"

With ws.QueryTables.Add(Connection:=rdate2, Destination:=Range("$A$1"))
.Name = "ctl00_ctl00_MainContent_MainContent_ReportTable"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables ' Adjust to xlAllTables if needed
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

cnt = 0
trg = 0

Do
cnt = cnt + 1
If trg = 1 And Cells(cnt, 1).Value = "" Then Exit Do
If Cells(cnt, 1).Value = "Region" Then trg = 1

If trg = 1 And Cells(cnt, 1).Value = "Quebec & Eastern Canada" Then
Worksheets("QUEBECEAST").Rows(que).Copy
Worksheets("QUEBECEAST").Select
ActiveSheet.Rows(que + 1).Select
ActiveSheet.Paste
Worksheets("sheet").Activate
Worksheets("QUEBECEAST").Cells(que + 1, 8).Value = Worksheets("sheet").Cells(cnt, 2).Value
Worksheets("QUEBECEAST").Cells(que + 1, 9).Value = Worksheets("sheet").Cells(cnt, 3).Value * 100
Worksheets("QUEBECEAST").Cells(que + 1, 10).Value = Worksheets("sheet").Cells(cnt, 4).Value
Worksheets("QUEBECEAST").Cells(que + 1, 11).Value = Worksheets("sheet").Cells(cnt, 5).Value
Worksheets("QUEBECEAST").Cells(que + 1, 12).Value = Worksheets("sheet").Cells(cnt, 6).Value
Worksheets("QUEBECEAST").Cells(que + 1, 13).Value = Worksheets("sheet").Cells(cnt, 7).Value
End If

If trg = 1 And Cells(cnt, 1).Value = "Ontario" Then
Worksheets("ONTARIO").Rows(ont).Copy
Worksheets("ONTARIO").Select
ActiveSheet.Rows(ont + 1).Select
ActiveSheet.Paste
Worksheets("sheet").Activate
Worksheets("ONTARIO").Cells(ont + 1, 8).Value = Worksheets("sheet").Cells(cnt, 2).Value
Worksheets("ONTARIO").Cells(ont + 1, 9).Value = Worksheets("sheet").Cells(cnt, 3).Value * 100
Worksheets("ONTARIO").Cells(ont + 1, 10).Value = Worksheets("sheet").Cells(cnt, 4).Value
Worksheets("ONTARIO").Cells(ont + 1, 11).Value = Worksheets("sheet").Cells(cnt, 5).Value
Worksheets("ONTARIO").Cells(ont + 1, 12).Value = Worksheets("sheet").Cells(cnt, 6).Value
Worksheets("ONTARIO").Cells(ont + 1, 13).Value = Worksheets("sheet").Cells(cnt, 7).Value
End If

If trg = 1 And Cells(cnt, 1).Value = "Western Canada" Then
Worksheets("WESTCAN").Rows(west).Copy
Worksheets("WESTCAN").Select
ActiveSheet.Rows(west + 1).Select
ActiveSheet.Paste
Worksheets("sheet").Activate
Worksheets("WESTCAN").Cells(west + 1, 8).Value = Worksheets("sheet").Cells(cnt, 2).Value
Worksheets("WESTCAN").Cells(west + 1, 9).Value = Worksheets("sheet").Cells(cnt, 3).Value * 100
Worksheets("WESTCAN").Cells(west + 1, 10).Value = Worksheets("sheet").Cells(cnt, 4).Value
Worksheets("WESTCAN").Cells(west + 1, 11).Value = Worksheets("sheet").Cells(cnt, 5).Value
Worksheets("WESTCAN").Cells(west + 1, 12).Value = Worksheets("sheet").Cells(cnt, 6).Value
Worksheets("WESTCAN").Cells(west + 1, 13).Value = Worksheets("sheet").Cells(cnt, 7).Value
End If
Loop


End Sub

 

[Dan_W]

The website you listed - such as it is - responds with an error: