Hi All
I am trying to do a web query to obtain data from a table split across multiple web pages and then insert the data onto one sheet in Excel.
I have been unable to get this to work.
I get the following error on the Refresh.BackgroundQuery=False line - Run-time error '1004': Application-defined or object-defined error
The connection seems to be established in Excel and when I click on the query and then on edit I can see the data but it's not loaded into the sheet and the loop does not run
Below is my current effort
Your help will be highly appreciated!
Thanks
Sub WebQuery1()
'
' WebQuery1 Macro
'
'
Dim p As Integer
Dim r As Integer
Dim l As Integer
Dim t As Integer
Dim WebString As String
Dim WebString2 As String
Dim WebSource As String
r = 1
l = 1
t = 2
For p = 1 To 352
WebString = "https://www.website.ashx?v=111&r=" & r
WebString2 = Chr(34) & WebString & Chr(34)
WebSource = "Source = Web.Page(Web.Contents(" & WebString2 & ")),"
ActiveWorkbook.Queries.Add Name:="Table" & t, Formula:= _
"let" & Chr(13) & "" & Chr(10) & WebSource & Chr(13) & "" & Chr(10) & " Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHeaders(Data2, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""No."", Int64.Type}, {""Ticker"", type text}, {""Company"", type text}, {""Sector" & _
""", type text}, {""Industry"", type text}, {""Country"", type text}, {""Market Cap"", type text}, {""P/E"", type text}, {""Price"", type number}, {""Change"", Percentage.Type}, {""Volume"", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table "" & t;Extended Properties=""""" _
, Destination:=Range("$A$" & l)).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table" & t & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_" & t
.Refresh BackgroundQuery:=False
End With
r = r + 20
t = t + 1
l = l + 21
Next p
End Sub
