OnTime TimeStamp值加倍

Question

当您启动RecordData() sub (从OpenMe() sub)时，它会完美地工作一次。每个时间戳日志都是连续的，没有重复。它在工作簿时，重新打开(由于OpenMe()/Close() subs)是当它创建了一个重复的时间戳日志。我是否可以重新安排OnTime，使其不会在下一次会话中安排替身？或者以某种方式将这两个OnTime分开，这样它们就独立了？

Dim NextTime As Double
Sub RecordData()
    Dim Interval As Double
    Dim cel As Range, Capture As Range

    Application.StatusBar = "Recording Started"
    Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
    With Worksheets("Journal") 'Record the data on this worksheet
        Set cel = .Range("A2") 'First timestamp goes here
        Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
        cel.Value = Now
        cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
    End With
    NextTime = Now + TimeValue("00:01:00")
    Application.OnTime NextTime, "RecordData"
End Sub

Sub StopRecordingData()
    Application.StatusBar = "Recording Stopped"
    Application.OnTime NextTime, "OpenMe", , False
End Sub

Sub OpenMe()
    Call RecordData
    Application.OnTime Now + TimeValue("00:10:00"), "CloseMe"
End Sub

Sub CloseMe()
    Application.OnTime Now + TimeValue("00:00:10"), "OpenMe"
    ThisWorkbook.Close True
End Sub

Answer 1

以下是一个等待sub的示例：

注意:此功能仅在excel中可用。

Option Explicit

Dim vntNextTime As Variant
Dim blnStopExecution As Boolean

Const c_strTotalRecordDataWaitTime As String = "00:05:00"
Const c_strCloseAndStopWaitTime As String = "00:00:30"


'This should be on the same sheet as your button!
Private Sub CommandButton1_Click()
    StopRecordingData
End Sub

'Private Sub WaitFor(intHrs As Integer, intMins As Integer, intSecs As Integer)
'    Dim newHour As Integer
'    Dim newMinute As Integer
'    Dim newSecond As Integer
'
'    Dim waitTime As Variant
'
'    newHour = Hour(Now()) + intHrs
'    newMinute = Minute(Now) + intMins
'    newSecond = Second(Now()) + intSecs
'
'    waitTime = TimeSerial(newHour, newMinute, newSecond)
'
'    Application.Wait waitTime
'End Sub

    Private Function CombineTime(intHrs As Integer, intMins As Integer, intSecs As Integer) As Long
        Dim lngTime As Long

        lngTime = intSecs + intMins * 60 + intHrs * 3600
        CombineTime = lngTime
    End Function

    Public Function GetTimeFromString(strInTime As String) As Long
        Dim strSplit() As String
        Dim intHrs As Integer
        Dim intMins As Integer
        Dim intSecs As Integer

        strSplit = Split(strInTime, ":")
        intHrs = CInt(strSplit(0))
        intMins = CInt(strSplit(1))
        intSecs = CInt(strSplit(2))

        GetTimeFromString = CombineTime(intHrs, intMins, intSecs)
    End Function


    Private Sub WaitFor(intHrs As Long, intMins As Long, intSecs As Long)
        Dim newHour As Integer
        Dim newMinute As Integer
        Dim newSecond As Integer
        Dim CurTime As Variant

        Dim waitTime As Variant

        newHour = Hour(Now()) + intHrs
        newMinute = Minute(Now) + intMins
        newSecond = Second(Now()) + intSecs

        waitTime = TimeSerial(newHour, newMinute, newSecond)

        'This is bad practice, but it will work for what you need.
        CurTime = 0
        Do While CurTime < waitTime
            newHour = Hour(Now())
            newMinute = Minute(Now)
            newSecond = Second(Now())

            CurTime = TimeSerial(newHour, newMinute, newSecond)
            DoEvents
            If blnStopExecution Then Exit Do
        Loop
        'Application.Wait waitTime
    End Sub


    Private Function GetNextTime(intHrs As Long, intMins As Long, intSecs As Long) As Variant
        Dim newHour As Integer
        Dim newMinute As Integer
        Dim newSecond As Integer

        Dim vntThisNextTime As Variant

        newHour = Hour(Now()) + intHrs
        newMinute = Minute(Now) + intMins
        newSecond = Second(Now()) + intSecs

        vntThisNextTime = TimeSerial(newHour, newMinute, newSecond)

        GetNextTime = vntThisNextTime
    End Function

    Private Sub RecordData()
        Dim Interval As Double
        Dim cel As Range, Capture As Range
        Dim intI As Integer
        Dim lngTimeStep As Long

        Application.StatusBar = "Recording Started"

        lngTimeStep = GetTimeFromString(c_strTotalRecordDataWaitTime) / 10

        For intI = 0 To 9
            WaitFor 0, 0, lngTimeStep
            If blnStopExecution Then Exit For

            Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
            With Worksheets("Journal") 'Record the data on this worksheet
                Set cel = .Range("A2") 'First timestamp goes here
                Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
                cel.Value = Now
                cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
            End With
        Next intI
    End Sub

    Public Sub OpenMe()
        blnStopExecution = False
        Call RecordData
        Call CloseMe
    End Sub

   Public Sub CloseMe()
        blnStopExecution = True

        vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
        Application.OnTime vntNextTime, "OpenMe"  'Now + TimeValue("00:00:10"), "OpenMe"

        ThisWorkbook.Close True
    End Sub

    Public Sub StopRecordingData()
        blnStopExecution = True
        Application.StatusBar = "Recording Stopped"

        vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
        Application.OnTime vntNextTime, "OpenMe"
    End Sub

‘我希望以一分钟为间隔记录/记录数据，然后在10分钟内关闭工作簿’，然后在10秒内重新打开