I would like a 1 second delay in my code. Below is the code I am trying to make this delay. I think it polls the date and time off the operating system and waits until the times match. I am having an issue with the delay. I think it does not poll the time when it matches the wait time and it just sits there and freezes up. It only freezes up about 5% of the time I run the code. I was wondering about Application.Wait and if there is a way to check if the polled time is greater than the wait time.
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
I use this little function for VBA.
Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Error_GoTo
Dim PauseTime As Variant
Dim Start As Variant
Dim Elapsed As Variant
PauseTime = NumberOfSeconds
Start = Timer
Elapsed = 0
Do While Timer < Start + PauseTime
Elapsed = Elapsed + 1
If Timer = 0 Then
' Crossing midnight
PauseTime = PauseTime - Elapsed
Start = 0
Elapsed = 0
End If
DoEvents
Loop
Exit_GoTo:
On Error GoTo 0
Exit Function
Error_GoTo:
Debug.Print Err.Number, Err.Description, Erl
GoTo Exit_GoTo
End Function
If you are in Excel VBA you can use the following.
Application.Wait(Now + TimeValue("0:00:01"))
(The time string should look like H:MM:SS.)
You can copy this in a module:
Sub WaitFor(NumOfSeconds As Long)
Dim SngSec as Long
SngSec=Timer + NumOfSeconds
Do while timer < sngsec
DoEvents
Loop
End sub
and whenever you want to apply the pause write:
Call WaitFor(1)
I hope that helps!
Have you tried to use Sleep?
There's an example HERE (copied below):
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
frmSplash.Show
DoEvents
Sleep 1000
Unload Me
frmProfiles.Show
End Sub
Notice it might freeze the application for the chosen amount of time.
Another variant of Steve Mallorys answer, I specifically needed excel to run off and do stuff while waiting and 1 second was too long.
'Wait for the specified number of milliseconds while processing the message pump
'This allows excel to catch up on background operations
Sub WaitFor(milliseconds As Single)
Dim finish As Single
Dim days As Integer
'Timer is the number of seconds since midnight (as a single)
finish = Timer + (milliseconds / 1000)
'If we are near midnight (or specify a very long time!) then finish could be
'greater than the maximum possible value of timer. Bring it down to sensible
'levels and count the number of midnights
While finish >= 86400
finish = finish - 86400
days = days + 1
Wend
Dim lastTime As Single
lastTime = Timer
'When we are on the correct day and the time is after the finish we can leave
While days >= 0 And Timer < finish
DoEvents
'Timer should be always increasing except when it rolls over midnight
'if it shrunk we've gone back in time or we're on a new day
If Timer < lastTime Then
days = days - 1
End If
lastTime = Timer
Wend
End Sub
The Timer function also applies to Access 2007, Access 2010, Access 2013, Access 2016, Access 2007 Developer, Access 2010 Developer, Access 2013 Developer. Insert this code to to pause time for certain amount of seconds
T0 = Timer
Do
Delay = Timer - T0
Loop Until Delay = 1 'Change this value to pause time in second
Access can always use the Excel procedure as long as the project has the Microsoft Excel XX.X object reference included:
Call Excel.Application.Wait(DateAdd("s",10,Now()))
Your code only creates a time without a date. If your assumption is correct that when it runs the application.wait the time actually already reached that time it will wait for 24 hours exactly. I also worry a bit about calling now() multiple times (could be different?) I would change the code to
application.wait DateAdd("s", 1, Now)
I used the answer of Steve Mallory, but I am affraid the timer never or at least sometimes does not go to 86400 nor 0 (zero) sharp (MS Access 2013). So I modified the code. I changed the midnight condition to "If Timer >= 86399 Then" and added the break of the loop "Exit Do" as follows:
Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Error_GoTo
Dim PauseTime As Variant
Dim Start As Variant
Dim Elapsed As Variant
PauseTime = NumberOfSeconds
Start = Timer
Elapsed = 0
Do While Timer < Start + PauseTime
Elapsed = Elapsed + 1
If Timer >= 86399
' Crossing midnight
' PauseTime = PauseTime - Elapsed
' Start = 0
' Elapsed = 0
Exit Do
End If
DoEvents
Loop
Exit_GoTo:
On Error GoTo 0
Exit Function
Error_GoTo:
Debug.Print Err.Number, Err.Description, Erl
GoTo Exit_GoTo
End Function
On Windows timer returns hundredths of a second... Most people just use seconds because on the Macintosh platform timer returns whole numbers.
With Due credits and thanks to Steve Mallroy.
I had midnight issues in Word and the below code worked for me
Public Function Pause(NumberOfSeconds As Variant)
' On Error GoTo Error_GoTo
Dim PauseTime, Start
Dim objWord As Word.Document
'PauseTime = 10 ' Set duration in seconds
PauseTime = NumberOfSeconds
Start = Timer ' Set start time.
If Start + PauseTime > 86399 Then 'playing safe hence 86399
Start = 0
Do While Timer > 1
DoEvents ' Yield to other processes.
Loop
End If
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
End Function
For MS Access: Launch a hidden form with Me.TimerInterval set and a Form_Timer event handler. Put your to-be-delayed code in the Form_Timer routine - exiting the routine after each execution.
E.g.:
Private Sub Form_Load()
Me.TimerInterval = 30000 ' 30 sec
End Sub
Private Sub Form_Timer()
Dim lngTimerInterval As Long: lngTimerInterval = Me.TimerInterval
Me.TimerInterval = 0
'<Your Code goes here>
Me.TimerInterval = lngTimerInterval
End Sub
"Your Code goes here" will be executed 30 seconds after the form is opened and 30 seconds after each subsequent execution.
Close the hidden form when done.
来源：https://stackoverflow.com/questions/6960434/timing-delays-in-vba