I am trying to write macro in excel to web query several sites to retrieve specific data from table. The web query is taking data in column A and displays results in Column C. The thing is that the table is being displayed in several rows and only two I need (date and price); rest to be deleted. The results should be transpose in columns B and C.(refresh eve开发者_如何学JAVAry hour). How the query could take care to fetch the required data and also to run in loop for other rows in column A and displays in C and D. Help and support is appreciated since I am new to VBA
A B c D
Site Date/Time Price
74156 xxx yyy
85940
....
....
code is as follows
Sub test1()
Dim qt As QueryTable
Set qt = ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.petro-canada.ca/en/locations/4085.aspx?MODE=DTS&ID=" & Range("A2").Value, Destination:=Range("c2"))
With qt
.Name = "Regular, Posted, Self serve"
.WebSelectionType = xlSpecifiedTables
.WebTables = "20" ' Regular table
.WebFormatting = xlWebFormattingNone
.EnableRefresh = True
.RefreshPeriod = 60 'Unit in minutes
.Refresh 'Execute query
End With
End Sub
Put your web query on a different page, then pull the data you need into your list on every refresh. Here's an example.
Sub GetPrices()
Dim rCell As Range
Dim lIDStart As Long
Dim qt As QueryTable
Const sIDTAG = "&ID="
Application.EnableEvents = False
Set qt = Sheet1.QueryTables(1)
'loop through site IDs
For Each rCell In Sheet2.Range("A2:A3").Cells
'find the id parameter in the web query connection
lIDStart = InStr(1, qt.Connection, sIDTAG)
'if found, change the ID
If lIDStart > 0 Then
qt.Connection = Left$(qt.Connection, lIDStart - 1) & sIDTAG & rCell.Value
Else 'if not found, add the id onto the end
qt.Connection = qt.Connection & sIDTAG & rCell.Value
End If
'refresh the query table
On Error Resume Next
qt.Refresh False
'if the web query worked
If Err.Number = 0 Then
'write the date
rCell.Offset(0, 1).Value = Sheet1.Range("A2").Value
'write the price
rCell.Offset(0, 2).Value = Sheet1.Range("A4").Value
Else 'if there was a problem with the query, write an error
rCell.Offset(0, 1).Value = "Invalid Site"
rCell.Offset(0, 2).Value = ""
End If
On Error GoTo 0
Next rCell
Application.EnableEvents = True
End Sub
An example can be found at http://www.dailydoseofexcel.com/excel/PetroWeb.xls
精彩评论