View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Don Guillett Don Guillett is offline
external usenet poster
 
Posts: 10,124
Default Yahoo Quotes Macro stops functioning

'sYahooUrl = "URL;http://quote.yahoo.com/d/quotes.csv?s=^GSPC"
sYahooUrl = "URL;http://download.finance.yahoo.com/d/quotes.csv?s=^GSPC"

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
try
"http://download.finance.yahoo.com/d/quotes.csv?s=^GSPC"

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"John V" wrote in message
...
I have been running a macro for eight months now that pulls current quotes
from Yahoo and puts them in a spreadsheet. For reasons unknown, the first
quote, S&P500 index, has stopped functioning. The macro returns the name
of
the index as "%5EGSPC" whereas it should be "S&P500". The ticker, ^GSPC,
works on their website. I do not believe I've made macro changes that
would
affect this in any way.

Please advise if you've encountered this problem and, better yet, a
solution. Thanks, John

code starts he

Sub GetData2()

Dim rCell As Range, rSymb As Range
Dim sYahooUrl As String
Dim qt As QueryTable
Dim rQtStart As Range

Set rQtStart = Sheet1.Range("A40")
Set rSymb = Sheet1.Range("B2", Sheet1.Range("B29").End(xlUp))
sYahooUrl = "URL;http://quote.yahoo.com/d/quotes.csv?s=^GSPC"

'build url with column B
For Each rCell In rSymb.Cells
sYahooUrl = sYahooUrl & "+" & rCell.Value
Next rCell

sYahooUrl = sYahooUrl & "&f=nl1c"

'get a query table if it exits
On Error Resume Next
Set qt = rQtStart.QueryTable
On Error GoTo 0

If qt Is Nothing Then 'create new
Set qt = Sheet1.QueryTables.Add(sYahooUrl, rQtStart)
Else 'update existing
qt.Connection = sYahooUrl
End If
On Error Resume Next
qt.Refresh False

'parse results
Application.DisplayAlerts = False
qt.ResultRange.TextToColumns _
Destination:=qt.ResultRange.Cells(1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Comma:=True
Application.DisplayAlerts = True

'reschedule update
StartTimer
Debug.Print Sheet1.QueryTables.Count

End Sub