在 Application.OnTime 循环 VBA 中的 2 个工作簿之间激活的最佳方法

Question

我有workbook1，它连接到数据 API。我希望每 5 秒从workbook1 拍摄一次单元格值的快照，并将其合并到下一个空行上workbook2 中的数据集。

但是我认为我的代码无法在两个工作簿之间正确切换。例如，我在workbook1 中有一些硬数字并运行了宏。代码按预期将硬数字从workbook1 复制并粘贴到workbook2。但是，一旦我手动更改了workbook1 中的数字，宏就无法获取workbook2 中后续合并行的更改。

有人可以帮忙吗？

Sub timer() 

If Hour(Time) <= 16 Then

Application.OnTime Now() + TimeValue("00:00:05"), "dataextract"

ElseIf Hour(Time) >= 18 Then

Application.OnTime Now() + TimeValue("00:00:05"), "dataextract"

End If

End Sub

Sub dataextract()

Dim Datetime As Date
Dim Bid As Single
Dim Ask As Single
Dim BidVol As Integer
Dim AskVol As Integer
Dim dataset As Workbook 

Worksheets("Sheet1").Select
Datetime = Range("B2")
Bid = Range("C2")
Ask = Range("D2")
BidVol = Range("E2")
AskVol = Range("F2")

Set dataset = Workbooks.Open("C:\Users\ali\Desktop\Dataset.xlsx") 'dataset is workbook2
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("B1").Select
RowCount = Worksheets("Sheet1").Range("B1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("B1")
.Offset(RowCount, 0) = Datetime
.Offset(RowCount, 1) = Bid
.Offset(RowCount, 2) = Ask
.Offset(RowCount, 3) = BidVol
.Offset(RowCount, 4) = AskVol
End With

dataset.Save

timer

End Sub

Answer 1

您应该测试外部工作簿是否已打开。

Sub timer()

    If Hour(Time) <= 16 Or Hour(Time) >= 18 Then

        Application.OnTime Now() + TimeValue("00:00:05"), "dataextract"

    End If

End Sub

Sub dataextract()
    Dim dataset As Workbook
    On Error Resume Next

    Set dataset = Workbooks("Dataset.xlsx")
    If dataset Is Nothing Then Set dataset = Workbooks.Open("C:\Users\ali\Desktop\Dataset.xlsx")

    On Error GoTo 0

    With dataset.Worksheets("Sheet1")
        With .Range("B" & .Rows.count).End(xlUp).Offset(1)

            .Resize(1, 5).Value = ThisWorkbook.Worksheets("Sheet1").Range("B2:F2")

        End With
    End With

    dataset.Save

    timer

End Sub