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
Related
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
Someone answered my question for Java and I'm basically building on a previous answer provided by #enderland here.
I'm running a webscraper and generally it works well but I often run into "runtime errors". I want to avoid this by skipping a specific assignment (in my case loading a patent page on Google.) if the time it takes to load the website takes too long.
I reckon a simple If Then is what I need but I don't know which function to use to control the elapsing of time.
Any suggestions?
At the moment I run the following:
Function citecount(patent_number As String, patent As String, ccount As Integer, info As String)
patent = ""
ccount = 0
If patent_number = "" Then Exit Function
the_start:
Set ie = CreateObject("InternetExplorer.Application")
ie.Top = 0
ie.Left = 0
ie.Width = 800
ie.Height = 600
ie.Visible = False 'If False we won't see the window navigation
On Error Resume Next
ie.Navigate ("http://www.google.com/patents/US" & patent_number & "?")
Sleep (600)
Do
DoEvents
If Err.Number <> 0 Then
ie.Quit
Set ie = Nothing
GoTo the_start:
End If
Sleep (1250)
Loop Until ie.ReadyState = 4
With Sleep() being defined as:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
The main error I face is described here. It's a Run-time error '2147467259 (80004005) automation error, unspecified error. Additionally, before I added the Sleep() commands I also got Microsoft Excel is waiting for another Application to complete an on OLE action but that has not come back since adding the Sleep() command.
Finally I get an IE warning:
Stop running this script?
A Script on thispage is causing your web browser to run slowly. If it continues to run your computer might become unresponsive
These are I think all caused by the fact that the webpage is taking loads of time downloading images that I do not need. I read some posts about loading a webpage directly in html without images on SO but could not find one that I could implement (novice at work).
Hope this provides clarification
I think you might want to rethink how you're using IE/your code to solve your problem in general. If you really just want to use a timeout to skip IE calls you can do the following.
Use this function to get the time elapsed between 2 dates:
Function ElapsedTimeInSeconds(endTime As Date, startTime As Date) As Long
' Calculate the time interval in seconds
If endTime > startTime Then
ElapsedTimeInSeconds = DateDiff("s", startTime, endTime)
Else
ElapsedTimeInSeconds = 0 ' cannot have negative elapsed time...
End If
End Function
Change your do Loop to take that into account
Dim startTime As Date: startTime = Now
Dim timeout As Long: timeout = 5 'seconds
Do
DoEvents
If Err.Number <> 0 Then
ie.Quit
Set ie = Nothing
GoTo the_start:
End If
Sleep (1250)
Loop Until ie.ReadyState = 4 Or ElapsedTimeInSeconds(Now, startTime) > timeout
OR you might want to play around with ElapsTimeInSeconds() function to go back to "the
_start", depending on how the rest of your code is structured.
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"
I have my service working mostly as it should, but it should only do it's work once every day.
To arrange this, my boss recommended I sleep the worker thread until 7am tomorrow:
This Thread.Sleep call is copied directly from a similar service he wrote that apparently works, but this always throws an ArgumentOutOfRangeException - the value returned is a negative.
Private Sub startExport()
#If Not Debug Then
Thread.Sleep(1000 * 60 * 1)
#End If
While runReportExport
Try
runExport()
Catch ex As Exception
el.WriteEntry("Error exporting data: {1}")
Finally
'sleep thread until tomorrow 7am
Thread.Sleep(DateTime.Now.Subtract(Date.Today.AddDays(1).AddHours(7)))
End Try
End While
End Sub
I'm fairly confused about how this all works so if anyone can explain the whole timespan thing for me, I'd greatly appreciate it.
On the other hand, my friend recommends I manage the thread execution in a different way.
Here's what He recommended I do:
Private lastExecute As DateTime = DateTime.Now
Private Overrides Sub OnStart(ByVal args() As String)
startService()
End Sub
Private Sub startService()
Dim nextExecute = lastExecute.AddDays(1)
If nextExecute >= DateTime.Now Then
lastExecute = DateTime.Now
tWorker = New Thread(AddressOf startExport)
tWorker.IsBackground = True
tWorker.Start()
End If
End Sub
He said this would execute the worker thread once on startup and not again for another day. While this code does work without error, it doesn't stop the service loop from executing the worker thread over and over again (currently it executes a 2nd time as soon as it finished it's first run)
Personally I'm open to either approach, I can't seem to get either working.
Basically, all I need at the end of the day is a service that exports data once daily.
My boss' Thread.Sleep option seems the simpler, but my friend's suggestion seems like better practice.
Can anyone help me to get this sorted (at this point I don't care which one I use, just so long as it works)?
DateTime.Now.Subtract(Date.Today.AddDays(1).AddHours(7)))
You subtract a future time from the current time. That always produces a negative value. Kaboom.
You'll need to invert that, subtracting the current time from the future time. Spelled out for clarity and avoiding the race on DateTime.Now :
Dim today = DateTime.Now
Dim tomorrow = today.Date.AddDays(1).AddHours(7)
Dim wait = tomorrow - today
Thread.Sleep(wait)
You will need to do something useful when the service is stopped. Best done with a ManualResetEvent, you'll get the sleep from its WaitOne(wait) method. Btw, extremely wasteful to have a thread sleep for that long and not doing anything useful. Use a Timer instead.
Another approach, and one I use, to run a specific task once a day is to set the task up in a timer. In my case I want the task to run at 12:05am each morning. Accordingly, when my program starts I set the initial interval of the timer such that the first tick will happen at 12:05 am the next day. After that, once a day, at the end of the code the executed as part of the tick I once again reset the timer interval such that the next tick will happen at 12:05am the next day.
...
Timer1.Interval = MillisecondsToMidnight() + 300000 ' next tick 12:05:00 tomorrow
...
Private Function MillisecondsToMidnight() As Integer
Dim ReturnValue As Integer
Dim ts As TimeSpan
Dim Tomorrow As DateTime = Today.AddDays(1)
ts = Tomorrow.Subtract(Now)
ReturnValue = ts.TotalMilliseconds()
ts = Nothing
Return ReturnValue
End Function