Excel - Auto update of daily web data into excel

[angelfire20]

Hi,

I want to set up an excel ssheet to automatically pull price data from a
website into a cell. Furthermore, each day I want the new price to be added
into the next available cell down from yesterday's update, in order for me to
keep a historical record and graph it.

Eg. on 2 Jan I want the script to update the gold price from
http://www.kitco.com/market/ to cell B5 and save. On 3 Jan I want it to
update the price into cell B6 and save, without overwriting B5, and so on.

Is this possible (using a macro or something), and if so what must I do.

Please provide easy to follow steps as I'm clueless! (-;

Thanks,

 

[Phil Hibbs]

Please provide easy to follow steps as I'm clueless! (-;

OK I'll get you started. I don't know how to do the internet fetch
thing but I can get a simple automation framework going. Let me know
if I'm pitching this too low

1. Open your spreadsheet and set up some formatting and headings
around where you want your data to go. I'm going to assume that A4 is
the date column heading and B4 is the gold price column heading. Make
sure you format your date column so that the date displays the way you
want it to, or you'll just see "######".
2. Hit Alt-F11, or select the Tools->Macro->Visual Basic Editor menu
option
3. Double-click on the entry for the sheet that you have set up, e.g.
"Sheet1" or "GoldPrice" or whatever you called it. I'm going to assume
it's the latter, "GoldPrice".
4. Enter the following code:

Sub GetGoldPrice()
Range("A4").Activate
While Selection <> "" And Selection <> Date
Selection.Range("A2").Activate ' go down 1 cell
Wend
Selection.Value = Format(Date, "DD MMM")
Selection.Range("B1").Activate ' Move across 1 cell
' Get the gold price and enter it
End Sub

3. Double-click on the "ThisWorkBook" entry in the VBAProject window
on the left side
4. Select "Workbook" in the drop-down menu above the code editor
window, this should automatically create a Workbook_Open() function
declaration
5. Enter the following code:

Private Sub Workbook_Open()
Sheets("GoldPrice").Activate
Run (Sheets("GoldPrice").CodeName & ".GetGoldPrice")
End Sub

Now you have a spreadsheet that automatically calls a macro whenever
it is opened. The macro that it calls selects the cell A4, moves down
until it either finds a blank cell or a cell with today's date in it,
and then moves across to the next column along. What you need now is
the code that fetches the data from the internet. I have no idea how
to do that!

Phil Hibbs.

 

[Phil Hibbs]

I've just seen the "How to load page with specific date?" thread,
which gives an example of driving an Internet Explorer application
instance to fetch and parse a web page. Perhaps that will help with
the next stage.

Phil Hibbs.

 

[Peter T]

A simple WebQuery should get this for you, followed by a simple routine to
copy the data to the last row on the prices sheet. Have a go with the
following, post back if not sure where to put it or how to run it.

Sub GetGoldPrice()
Dim wsWQ As Worksheet
Dim wsPrices As Worksheet
Dim qt As QueryTable
Dim wb As Workbook

Set wb = ActiveWorkbook
On Error Resume Next
Set wsWQ = wb.Worksheets("KitcoQuery")
If wsWQ Is Nothing Then
Set wsWQ = wb.Worksheets.Add
wsWQ.Name = "KitcoQuery"
End If


Set qt = wsWQ.QueryTables("KitcoGoldPrice")
If qt Is Nothing Then
If AddKitcoQT(wsWQ, qt) = False Then
MsgBox "Failed to add WebWuery"
Exit Sub
End If
Else
qt.BackgroundQuery = False
qt.Refresh
End If

Set wsPrices = wb.Worksheets("GoldPrices")
If wsPrices Is Nothing Then
Set wsPrices = wb.Worksheets.Add
wsPrices.Name = "GoldPrices"
wsPrices.Range("A1:H1").Value = wsWQ.Range("C4:J4").Value
End If

wsPrices.Parent.Activate
wsPrices.Activate

nLastRow = wsPrices.Range("A60000").End(xlUp).Row + 1

wsWQ.Range("C6:J6").Copy _
Destination:=wsPrices.Range(Cells(nLastRow, 1), _
Cells(nLastRow, 8))


End Sub

Function AddKitcoQT(ws, qt) As Boolean
On Error GoTo errH
Set qt = ws.QueryTables.Add(Connection:= _
"URL;http://www.kitco.com/market", Destination:=ws.Range("A1"))
With qt
.Name = "KitcoGoldPrice"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

AddKitcoQT = True
Exit Function
errH:
End Function


Regards,
Peter T