0

Google Finance のポートフォリオから株価をダウンロードするための簡単な VBA プログラムを作成しました。数時間は正常に動作し、その後ハングアップします。アプリケーションのステータスバーには、「接続中」(インターネット?) と表示されます。スタックすると、ESC キーに反応しなくなり、Windows タスク マネージャーで強制的に終了させました。

ポートフォリオは 5 分ごとに 1 回アクセスされ、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 で何もできないことです。一方、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 は、次の見積もりまでの時間を示すカウントダウン タイマー表示を作成します。「RUN」ボタンは、このマクロを指してプログラムを開始します。プログラムが最初に開かれたとき、すべての変数はゼロで、マクロはタイマー表示を「00:00」に設定し、Quote マクロを呼び出し、カウント ダウン タイマーを再初期化し、タイマー マクロを開始します。停止マクロも含まれています。停止後、再度 RUN を押すと、時計が手動でリセットされていない限り (Reset_Clock マクロとユーザー ボタン)、タイマーは中断したところから再開します。

接続が完了したら、接続とクエリ テーブルを削除するのがおそらく良い方法です。最初のプログラムのデバッグで、800 以上の接続を蓄積したので、これらをクリーンアップするためにいくつかのループを追加しました。これは、Quote マクロの最後で発生するようになりました。

于 2014-05-20T04:44:40.040 に答える