在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