0

我编写了一个简单的 VBA 程序来从 Google 财经的投资组合中下载股票报价。它可以正常工作几个小时，然后挂断。在应用程序状态栏中，它显示“正在连接”（互联网？）。一旦卡住它就不会响应 ESC 键，我已经强制它以 Windows 任务管理器结束。

每 5 分钟访问一次投资组合，并将放置在 A1 的数据复制到单独的页面进行存储。访问投资组合的代码是：

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

该错误是随机发生的，通常在很长一段时间（数小时）之后发生，并且它似乎与一天中的时间无关。

我尝试设置 Refresh BackgroundQuery:=TRUE ，结果是程序挂起时弹出一个消息框。确认消息框似乎可以解决问题，但我需要程序自主运行并在没有保姆的情况下处理这些问题。

4

1 回答 1

0

我发现这个问题是由于使用 Application.wait 创建一个计时器造成的，但不能说停顿的机制是什么，只是执行在查询命令处停止。我的原始程序有一个倒计时 5 分钟的计时器，然后向 Google 查询 Google 投资组合中股票代码的当前股票价格。解决方案是改用 Application.OnTime。这样做的一个附带好处是 Excel 的注意力完全被 Application.wait 所消耗，因此在 Excel 运行时无法在 Excel 中执行任何操作。另一方面，Application.OnTime 似乎将计时器功能卸载到硬件或 ??，这样 Excel 本身就可以在等待计时器超时时执行其他操作。

整个程序如下所示：

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

Sub TicToc 创建一个倒计时显示，指示距离下一次报价还有多长时间。“运行”按钮指向此宏以启动程序。当程序第一次打开时，所有变量都为零，宏会将计时器显示设置为“00:00”并调用 Quote 宏，然后重新初始化倒数计时器并启动计时器宏。还包括一个停止宏。如果再次按下 RUN 则停止后，除非手动重置时钟（Reset_Clock 宏和用户按钮），否则计时器将从停止的地方开始。

完成后删除连接和查询表可能是一种很好的形式。在调试第一个程序时，我积累了 800 多个连接，因此我添加了几个循环来清理这些连接。这现在发生在 Quote 宏的末尾。

于 2014-05-20T04:44:40.040 回答