web download stalled in VBA

Question

I've written a simple VBA program to download stock quotes from a portfolio in Google Finance. It works fine for a couple of hours and then hangs up. In the applications status bar it says "Connecting to" (internet?). Once stuck it won't respond to the ESC key and I have force it to end with the Windows Task Manager.

The portfolio is accessed once every 5 minutes and the data placed at A1 is copied to a separate page for storage. The code to access the portfolio is:

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;https://www.google.com/finance#", Destination:=Range("$A$1"))
    .Name = "finance#"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = """portfolio1"""
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

The error occurs randomly, usually after a long period of time (hours) and it doesn't appear to be time of day dependent.

I tried setting Refresh BackgroundQuery:=TRUE with the result being a message box pops up when the program hangs. Acknowledging the message box appears to clear the problem but I need the program to run autonomously and handle these hiccups without a babysitter.

Answer 1

I found this problem results from using Application.wait to create a timer but can't say what the mechanics of the stalling are, just that the execution stops at the query command. My original program had a timer which counted down 5 minutes and then queried Google for current stock prices for ticker symbols in a Google portfolio. The solution has been to use Application.OnTime instead. A side benefit of this is Excel's attention is fully consumed with Application.wait such that nothing can be done in Excel while its running. Application.OnTime on the other hand seems to offload the timer function to hardware, or ??, such that Excel itself is available to do other things while waiting for the timer to time out.

The whole program looks like this:

Dim Clock As Date               'CountDown time
Dim Click As Date               'Default time of 12:00:00 AM if no other input is given. Here functions as '0' in Date format
Dim Wait As String              'Wait format = "00:10:00"  = 10 minutes
Dim Text As String              'Capture user input for delay between quotes

Dim SchTime As Date

Sub Initialize()

Worksheets("Daily").Select
Text = Cells(2, 1).Value        'user supplied time between quotes: 1-59 minutes
Wait = "00:" + Text + ":00"
Clock = TimeValue(Wait)

End Sub

Sub Timer()

SchTime = Now + TimeValue("00:00:01")
Application.OnTime SchTime, "TicToc"

End Sub


Sub End_Timer()

Application.OnTime EarliestTime:=SchTime, _
Procedure:="TicToc", Schedule:=False

End Sub

Sub Quote()
Dim QueryTables As Worksheet
Dim RowNum As Integer
Dim A As String
Dim Shift As String

Application.ScreenUpdating = False

Sheets("5 min update").Select
A = Range("L2")                     'Get user supplied time offset to adjust local time zone to NY time
Sheets("Daily").Select

'Find Next empty row for data

RowNum = 8
While Cells(RowNum, 7) <> ""
    RowNum = RowNum + 1              'where to start putting data on the page
Wend

Sheets("5 min update").Select

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;https://www.google.com/finance#", Destination:=Range("$A$1"))
    .Name = "finance#"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = """portfolio1"""
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

Sheets("5 min update").Select

'Move Tickers to rolling table

Sheets("Daily").Select
    Range("G8", "T8").Select
    Selection.ClearContents
Sheets("5 min update").Select
Range("A1", Range("A1").End(xlDown)).Select
Selection.Copy
Sheets("Daily").Select
Cells(8, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True


'Move $$ quote to rolling table

Sheets("5 min update").Select
Range("B1", Range("B1").End(xlDown)).Select
Selection.Copy
Sheets("Daily").Select
Cells(RowNum, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

'Time stamp

Shift = "0" + A + ":00:00"

Cells(RowNum, 4).Value = Date + TimeValue(Shift)  '("03:00:00")
Cells(RowNum, 4).NumberFormat = "ddd"
Cells(RowNum, 5).Value = Date + TimeValue(Shift)
Cells(RowNum, 5).NumberFormat = "dd-mmm-yy"
Cells(RowNum, 6).Value = Now + TimeValue(Shift)
Cells(RowNum, 6).NumberFormat = "h:mm AM/PM"

'Clean up your mess: close connections and QueryTables

Dim I As Integer
Dim ws As Worksheet
Dim qt As QueryTable
For Each ws In ThisWorkbook.Worksheets
For Each qt In ws.QueryTables
qt.Delete
Next qt
Next ws

If ActiveWorkbook.Connections.count > 0 Then
    For I = 1 To ActiveWorkbook.Connections.count
    ActiveWorkbook.Connections.Item(1).Delete
    Next I
End If

Range("A5").Select
ThisWorkbook.Save

Application.ScreenUpdating = True

End Sub


Sub TicToc()

'Display Countdown till next quote comes in

If Clock > Click Then                          'Click = '0' in Date format
    Range("A4").Value = Clock
    Clock = Clock - TimeValue("00:00:01")
Else
    Range("A4").Value = "00:00"
    Call Quote
    Call Initialize
End If

Call Timer

End Sub

Sub Reset_Clock()

Worksheets("Daily").Select
Clock = "00:00"
Range("A4").Value = "00:00"

End Sub

The Sub TicToc creates a countdown timer display indicating how long until the next quote. A 'RUN' button points to this macro to begin the program. When the program is first opened all variables are zero the macro will set the timer display to "00:00" and call the Quote macro, then re-initializes the count down timer and starts the timer macro. A stop macro is also included. After STOPping if RUN is pressed again the timer will pick up where it left off unless the clock has been manually reset (Reset_Clock macro and a user button).

Its probably good form to delete connections and query tables when you're done with them. In debugging the first program I accumulated over 800 connections so I added a couple of loops to clean these up. This now occurs at the end of the Quote macro.