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

Question

我有连接到数据API的workbook1。我希望从workbook1每隔5秒拍摄一次单元格值的快照，并将其合并到下一个空行上的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