Data Connection Proliferation

[John V]

I cobbled together a set of macros (below) to periodically query Yahoo
finance and download quotes. This spreadsheet would ideally run 24/7. I
noticed after a few weeks that it grew larger and slower. I discovered, under
Data Connections, about 7000 identical connections that had been created (and
saved). Just deleting them will be a massive chore, but avoiding them
entirely would be desirable.

Obviously I'm doing something wrong here. Any help appreciated.

Code begins:
Public RunWhen As Double
Public PauseStuff As Boolean
Public Const cRunIntervalSeconds = 120 ' two minutes
Public Const cRunWhat = "GetData" ' the name of the procedure to run


Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
'PauseStuff = True 'if true, getdata
End Sub



Sub GetData()

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
If Not PauseStuff Then GoTo OnPause
Set DataSheet = Worksheets("Sheet2")
DataSheet.Activate
Range("A30").CurrentRegion.ClearContents
Range("b2").Select
i = 1
yahoourl = "http://quote.yahoo.com/d/quotes.csv?s=^GSPC + " +
ActiveCell.Value

ActiveCell.Offset(1, 0).Select
While ActiveCell <> ""
yahoourl = yahoourl + "+" + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Wend
yahoourl = yahoourl + "&f=nl1c"

QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & yahoourl,
Destination:=Range("A30"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Range("a30").CurrentRegion.TextToColumns
Destination:=Range("a30"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Columns("A:A").ColumnWidth = 28#
'Cells(2, 3).Select
OnPause:
StartTimer

End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False
End Sub
Sub Pausequery()
PauseStuff = Not PauseStuff
Worksheets("Yahoo").Activate
If Range("A1") = "" Then Range("A1") = "WEB QUERY PAUSED" Else Range("a1") =
""

End Sub

 

[Dick Kusleika]

I cobbled together a set of macros (below) to periodically query Yahoo
finance and download quotes. This spreadsheet would ideally run 24/7. I
noticed after a few weeks that it grew larger and slower. I discovered, under
Data Connections, about 7000 identical connections that had been created (and
saved). Just deleting them will be a massive chore, but avoiding them
entirely would be desirable.

With ActiveSheet.QueryTables.Add(Connection:="URL;" & yahoourl,

A couple of points: Every time you add a new QueryTable, you create a new
connection. You aren't deleting the existing QT before you add the new one.
However, you don't really want to delete the old and add the new. What you
want to do is change the properties of the old QT and refresh it. How much
work it is to change the properties is the subject of point two.

I assume the cells contain ticker symbols. If those cells never change, you
don't have to any coding at all. Just change the QT properties to refresh
automatically every two minutes.

If the symbols do change, then a little code will be required. In that case
you need to build the URL and change the Connection property of the
querytable. Here's a revised GetData sub for you to consider

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("A30")
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

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

If possible, you should start with a fresh workbook. You can copy the
contents of the sheet over, but you want to start with a workbook with no
querytables. With the above code, you should never have more than one.

 

[Dick Kusleika]

A couple of points: Every time you add a new QueryTable, you create a new
connection. You aren't deleting the existing QT before you add the new one.
However, you don't really want to delete the old and add the new. What you
want to do is change the properties of the old QT and refresh it. How much
work it is to change the properties is the subject of point two.

See also
http://www.dailydoseofexcel.com/archives/2008/04/01/updating-stock-quotes/