PDA

View Full Version : CTRL + Break



av8tordude
03-16-2011, 05:13 PM
I would like to have a userform button to allow the user to stop a DoEvent code that is running to long. I know I can use CTRL + COMMAND, but I would like a button to excute this command Can someone assist. Thanks.

Paul_Hossler
03-16-2011, 05:52 PM
Do you mean a loop that has DoEvents in it to allow Windows to catch up?

If so, have the button to stop it just set a flag, and then test the flag inside the loop, and exit the loop when the flag is set

Paul

mdmackillop
03-16-2011, 06:08 PM
You may need a DoEvents line in your loop to allow the button event to happen
Option Explicit
Dim t

Sub testloop()

Dim i As Long
t = True
For i = 1 To 10000
DoEvents
If t = False Then Exit For
Cells(i, 1) = i
Next
End Sub

Sub Interrupt()
t = False
End Sub


Edit: Just read your post properly Paul. You already had the DoEvents!

av8tordude
03-17-2011, 07:42 AM
Hi Everyone.

When my internet is slow, the code runs very slow, so I would like to be able to stop the code from running without have to using the Ctrl +Break key strokes. I attached a workbook with the code. Can someone assists. thanks

Paul_Hossler
03-17-2011, 09:43 AM
try this


Option Explicit
Dim bUserWantsToQuit As Boolean
Private Sub CommandButton1_Click()
bUserWantsToQuit = False
VersionCheck
End Sub
Private Sub CommandButton2_Click()
bUserWantsToQuit = True
End Sub
Function VersionCheck() As String
Dim strControlID As String
Dim strReportID As String
Dim oBrowser As Object 'InternetExplorer
Dim sURL As String
Dim strVersion As String
sURL = "http://www.pdtraveler.com/download.htm"
Set oBrowser = CreateObject("InternetExplorer.Application")
oBrowser.Silent = True
oBrowser.Navigate sURL
Do
DoEvents
Loop Until (oBrowser.ReadyState = 4) Or bUserWantsToQuit
If bUserWantsToQuit Then
UserForm1.Hide
Unload UserForm1

MsgBox "OK, I'm going to stop checking", vbInformation

Else
UserForm1.Hide
Unload UserForm1

strVersion = oBrowser.document.DocumentElement.innerText
If strVersion = vbNullString Then Exit Function
strVersion = Mid(strVersion, InStr(1, strVersion, "Version"), 25)
strVersion = Trim(Left(strVersion, InStr(1, strVersion, vbCrLf) - 1))
VersionCheck = strVersion
oBrowser.Quit

MsgBox "Check is complete", vbInformation
End If

End Function


Paul