I currently have a macro that has a built in timer that i have coded, and after a set interval it calls a subroutine "increment_count". increment count is a subroutine that just counts up. I was wondering, is it possible for me to use milliseconds? i have tried adding another colon and then milliseconds but it did not seem to work, why? Please help
Sub StartTimer()
Application.OnTime Now + TimeValue("00:00:30"), "increment_count"
End Sub
Thank You
Application.OnTime Now + (TimeValue("00:00:01") / 1000), "increment_count"
Related
I've got a legacy VBA function which I want to stop running if it takes longer than 3 minutes - please see below for code I have so far.
Obviously, the MsgBox only shows once function has completed but I need it to show and exit a function during.
Dim startTime As Long
startTime = GetTickCount
Do
If GetTickCount - startTime > 10000 Then
MsgBox "There seems to be an issue. Please try again!"
Exit Do
End If
doStuff
Loop
Can anyone help me out?!
Many Thanks in advance.
If the code is in that same sum you can just add Exit Sub after your msgbox.
there is here for 10 seconds
Dim startTime As Date
startTime = Now
Do
If DateDiff("s", startTime, Now) > 10 Then
MsgBox "There seems to be an issue. Please try again!"
Exit Do
End If
dostuff
Loop
But this works only if duration of dostuff is < 10 seconds. Otherwise you must put the check into dostuff
Check the TickCount inside the function:
Function doStuff()
-your code.....
If GetTickCount - startTime > 10000 Then
Exit Function
-your code.....
-your code.....
-your code.....
If GetTickCount - startTime > 10000 Then
Exit Function
End Function
If the issue is that the Function doStuff is taking too long to run, then you will definitely need an Exit in the function itself.
Without knowing what the function itself does exactly, we cannot give specific advice for that.
But for instance, if the problem is one singular query that takes too long, then the issue cannot really be avoided. If the problem is you want it to Exit in between certain running portions of your function, just place a timer / Exit clause into the function where it might hang and the timer "passes 2 minutes".
By all this I mean, switch your original code around a little bit:
If GetTickCount - startTime > 10000 Then
MsgBox "There seems to be an issue. Please try again!"
Exit Function
End If
OR (if your function runs some kind of loop in itself, you could modify the Do in the loop itself):
Do While GetTickCount - startTime > 10000
'Code here
Loop
Simple Question, I must just be missing something obvious.
I am trying to create a subroutine that polls for a window to be open and I am aiming to accomplish this by a loop that will run while two conditions are met. I keep getting an error:
Run time error 13: Type Mismatch
On the Do while loop, and after searching through the similar issues on SO I still am not quite sure what I am doing wrong.
Here is the line that keeps erroring out:
Sub FindHWND()
Dim HWNDOut as string
Dim Timer as Date
Timer = Now()
'This following line is the one erroring out.
Do While ((Now() < Timer + TimeValue("00:00:10")) And (HWNDOut = 0))
HWNDOut = CStr(Hex(FindWindowEx(0&, 0, "SunAwtFrame", "Graph.graphml - yEd")))
Debug.Print HWNDOut
Sleep (100)
Loop
'Other, following sub and code that is not relevant
End Sub
Where Timer is the Now() at moment before the loop starts, and HWNDOut is the handle for the window I am looking for, which will be found in the loop.
All this loop does is look every 100 MS to see if the window to a third party program has opened, in order to prevent the loss of commands in the next subroutines.
Post Script: If anyone has any suggestions how to do this better, I'm all ears. This is my first time using UI Automation so I'm still learning.
Edit: Added more code to the block for context.
With:
And (HWNDOut = 0))
you are comparing a String to a numeric value..............this will fail.
Try changing variable name Timer to something else e.g. StartTime (think there is a Timer function in VBA which returns a value of a different type; so best not to use words which are reserved or semantically significant).
Might help, might not, good luck.
Since I just found out about Excel Macros, I want to try to simulate moving objects. I would like to run some looped code every 'frame' of my project. I can make an infinite loop in Excel VBA with this code:
Do While True:
'code
Loop
However, this crashes Excel. Is there a way to make an infinite loop that runs every ten milliseconds or so, something like this:
Dim timer as Timer
If timer = 10 Then
'code
timer = 0
End If
EDIT: Your answers are very good, but not exactly what I'm looking for. I want to be able to run other code at the same time; a bit like Javascript's
setInterval(function(){}, 200);
which can run multiple functions simultaneously.
You can use an API call and Sleep.
Put this at the top of your module:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then you can call it in a procedure like this:
Do While True:
Sleep 10 'wait 0.01 seconds
Loop
If the code is in 64bit OS, you will need to use PtrSafe. See https://support.microsoft.com/en-us/help/983043/compile-error-the-code-in-this-project-must-be-updated-for-use-on-64
Your original method is crashing Excel because it is creating an infinite loop with no exit condition.
The second method doesn't work because your system clock time (given by Timer) will never be 10, if you use debug.Print(Timer) in your Immediate Window you will see its value.
Here is some commented code to execute some actions based on a timer. Please please PLEASE make sure you retain the runtime condition for exiting the while loop, infinite loops are the devil and really you should have some other exit code in here somewhere!
Sub timeloop()
Dim start As Double: start = Timer ' Use Timer to get current time
Dim t As Double: t = start ' Set current time "t" equal to start
Dim interval As Double: interval = 1 ' Interval for loop update (seconds)
Dim nIntervals As Long: nIntervals = 0 ' Number of intervals passed
' Use this While loop to avoid an infinite duration! Only runs for "runtime" seconds
Dim runtime As Double: runtime = 10
Do While t < start + runtime
' Check if a full interval has passed
If (t - start) / interval > nIntervals Then
nIntervals = nIntervals + 1
' Do stuff here ---
Debug.Print (t)
' -----------------
End If
t = Timer ' Update current time
Loop
End Sub
Could anyone please tell me if and how it is possible to count time of running various modules in VBA excel?
I am only able to count the elapsed time of one single module. However, when it comes to more than 1 module it seems there is no info out there. Or I am blind.
With one module I pass Timer value to a variable set at the begining of code and then at the end. Then I deduct second variable from the first.
When I try to do it between modules initial variable value is reset to empty.
Many thanks for any pointers
Tommeck37
For a simple way to measure the time it takes to execute portions of your code, you can use the VBA timer() function. That function isn't perfect, but it's a good place to start.
Timer() returns the number of seconds that have elapsed since midnight, including fractions.
Just before you call a module, assign the result of timer() to a variable. Timer returns a Double, but you could store it in a variant, too. Then do another call to timer() just after the module. For example:
time1 = timer()
call Proc1()
time2 = timer()
call Proc2()
time3 = timer()
debug.print "Proc1 time: " & cStr(time2-time1)
debug.print "Proc2 time: " & cStr(time3-time2)
There are other timers that you can use in VBA, but they require using windows procedures, and are harder to setup and use. For gross timing, this works fine. If you want to time with millisecond accuracy (or better), then look into other ways.
I've got an question about resetting a label every night at the same time.
What do i mean:
1. when starting the program my label.text = 750
every time someone clicks a button the label text reduces with 1 so
750
749
748 etc etc
but now i want that every day at 00:00 the label's text resets to 750.
is that possible??
Javed Akram's comment is correct -- none of this is going to matter, if the program isn't running at midnight.
However, for what you actually asked for - resetting a count at midnight - consider adding a TIMER to your project. You really only need the timer to click once a day (at midnight):
Private Sub SetInterval()
' Calculate how many milliseconds until the timer ticks again:
' Start by calculating the number of seconds between now and tomorrow.
' Multiply by 1000, then add 50 more -- this is to make sure that the
' timer runs 1/50 of a second AFTER midnight, so that we can
' re-calculate the interval again at that time.
Timer1.Interval = CInt( _
DateDiff(DateInterval.Second, Now, Today.AddDays(1)) * 1000 + 50)
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Timer1.Tick
' Reset the interval, so that we run again tomorrow at midnight.
SetInterval()
' Now, reset your label
Label1.Text = "750" ' Or whatever else needs to happen to reset the count
End Sub
You'll also need to add a call to SetInterval in Form_Load (or whatever your program initialization is), to set up the very first interval.
On an almost completely UN-related note, does anyone know why the Date class has an AddMilliseconds function, but Microsoft.VisualBasic.DateInterval (and therefore the DateDiff function) doesn't have Milliseconds? It's non-symmetrical.