Anytime I write VBA code that runs for more than a split second, one of my worries remains that someone will ctrl + break it. You see, I am a very strong supporter of P.E.T.A. (People for Ethical Treatment of Algorithms) and believe that any code, no matter how long it takes (or in my case how badly written it is), must be allowed the dignity to complete. And for those who believe in killing poor little VBA code(s) with a ctrl + break, I just got a neat little trick up my sleeve. Here’s how it goes:
Take for example some VBA code that runs for a few seconds. It is important that the user let it run for that duration without stopping code execution since there are a lot of intermediate sheets, rows and columns that the code generates and subsequently deletes before exiting. If the user stops the code execution in between, they are left with a pretty ugly spreadsheet. (… now I know that opening the workbook again is always an option but hey that wouldn’t be half the fun would it 😎 …)
So the trick to prevent VBA code execution by pressing ctrl + break is to insert this magic statement in the VBA code:
1 | Application.EnableCancelKey = xlErrorHandler |
The statement instructs Excel to not show the “Code execution has been interrupted” message and provides a way for the developer to tap into the ctrl + break action by the user. Essentially there can be three values for Application.EnableCancelKey : xlDisabled, xlErrorHandler and xlInterrupt. By setting Application.EnableCancelKey = xlDisabled, we are essentially telling the application to stop responding to the ctrl + break command from the user. If the code runs haywire … too bad. The xlInterrupt is the normal course of action where the user can terminate the code and is the value that the application resets to after the code has run its course. The xlErrorHandler is the one that lets the developer instruct the application generate an error (code 18) and then to tap into that error by using error handling.
Here is a code that is supposed to run for 5 seconds. If the user tries to stop the code prematurely, the xlErrorHandler kicks in and let the application raise an error. This error is then tapped by the error handler (On Error GoTo MyErrorHandler) and error handing code, after checking for the exact error code (error code 18 in this case), lets the code execution resume from where it left off.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | Sub code_that_runs_5_seconds() On Error GoTo MyErrorHandler: t = Timer Application.EnableCancelKey = xlErrorHandler Do While Timer - t < 5 Loop MyErrorHandler: If Err.Number = 18 Then MsgBox "Stop hitting ctrl + break !!!" Resume Else 'Do something to make your impatient user happy End If End Sub |
Another interesting thing to note is that you can have more than one Application.EnableCancelKey instructions in a piece of code. For the portions of the code over which you (the developer) want to exert control, you can have it set to xlErrorHandler and for the other pieces you can let the user retain it by setting it to xlInterrupt later down the line.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | Sub another_code_that_runs_5_seconds() On Error GoTo MyErrorHandler: t = Timer Application.EnableCancelKey = xlErrorHandler Do While Timer - t < 5 Loop MsgBox 1 Application.EnableCancelKey = xlInterrupt Do While Timer - t < 10 Loop MyErrorHandler: If Err.Number = 18 Then MsgBox "Stop hitting ctrl + break" Resume Else 'Do something to make your impatient user happy End If End Sub |
Go ahead – take control 🙂
You can download an example here here or click on the button below
One of the nice things about locking the VBA project with a password is that when the user hits , the dialog buttons allow only [Continue] and [End]. [Debug] is disabled.
April 6th, 2010 at 12:00 pmNot as complete a solution as EnableCnacelKey, but reasonable. I always worry that, as the admin, I will need to press ESC and not be able to.
You can always set it to look at the username before setting the value. If it is you who is running the code, you can make it let you do whatever you want, but for anyone not in the list, you can make them do it your way. Also could surely do it based on windows login permission level… admin vs power user, etc.
April 30th, 2010 at 9:14 amGreat tip 🙂
July 19th, 2011 at 6:04 pmProgramming without little fun is too damn serious, and taking control has its charmes…
Thx.
Sorry to say this, but if you hit ctrl + break twice, there’s a vba error. It works the first time you interrupt the macro, though.
November 16th, 2012 at 5:11 pmThis is blasphemy, this is madness!
April 15th, 2013 at 4:38 amYou simply cannot just walk into errorhandler(mordor), and stop the evil king.
thanks for such a great tip
May 28th, 2013 at 2:15 pmHi team Any one help me out to rectified this need to change lotus mail converted into outlook how can we use this thru out look please help
vb code given below
Sub sendmail()
‘
‘ sendmail Macro
‘
Dim dte As Date
January 14th, 2016 at 4:04 amDim mon As Integer
Dim yr As Integer
Dim mailcount As Integer
Dim filtercol As Integer
Dim Maildb As Object
Dim MailDoc As Object
Dim attachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim UserName As String
Dim MailDbName As String
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim finlsub As String
Dim stSignature As String
Dim addname As String
Dim bodytext As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim FilName As String
Application.DisplayAlerts = False
dte = Date
mon = Month(dte)
yr = Year(dte)
Attachment2 = Range(“F15”).Value
Sheets(“MAIL-ID”).Activate
Range(“AG2”).Value = 0
mailcount = Range(“AG14”).Value
subject = Range(“F2”).Value
bodytext = Range(“F6”).Value & Chr(10) & Range(“F7”).Value & Chr(10) & Range(“F8”).Value & Chr(10) & Range(“F9”).Value & Chr(10) & Range(“F10”).Value & Chr(10)
addname = Range(“F12”).Value
If mon = 12 Then GoTo exitsub
exitsub: If UCase(Environ$(“USERDOMAIN”)) “ONEAIRTEL” Then MsgBox “This is not your copy of Filtermails ” & Chr(10) & “You are an UNAUTHORISED USER “, vbCritical
Exit Sub
validated: If mailcount = 0 Then MsgBox “There are no recepients in your list.”, vbCritical, “WHAT ARE YOU DOING?”
For x = 0 To (mailcount – 1)
Sheets(“MAIL-ID”).Select
Range(“AG2”).Value = x + 1
FilName = (Environ$(“temp”)) & “\temp.xls”
If Dir(FilName) “” Then
Kill FilName
End If
filtercol = Range(“F4”).Value
Range(“AG4”).Select
Selection.Copy
Range(“AG7”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
recipient = Range(“AG7”).Value
Range(“AG5”).Select
Selection.Copy
Range(“AG8”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ccRecipient = Range(“AG8”).Value
If ccRecipient = “0” Then
ccRecipient = “”
End If
Range(“AG6”).Select
Selection.Copy
Range(“AG9”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
bccRecipient = Range(“AG9”).Value
If bccRecipient = “0” Then
bccRecipient = “”
End If
Range(“AG3”).Select
Selection.Copy
Range(“AG11”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range(“AG11”).Copy (Sheets(“DATA”).Range(“O60000”))
Sheets(“DATA”).Select
If addname = “YES” Then
finlsub = subject & ” ( ” & Range(“O60000″).Value & ” )”
finlbody = “Dear ” & Range(“O60000”).Value & Chr(10) & Chr(10) & bodytext
End If
If addname = “NO” Then
finlsub = subject
finlbody = bodytext
End If
Range(“A1”).Select
If Range(“a1”) = “” Then
MsgBox “NO or Wrong arrangement of Data in DATA Sheet”, vbCritical
Exit For
End If
Selection.AutoFilter
Selection.AutoFilter field:=filtercol, Criteria1:= _
Range(“O60000”).Value
Range(“A1″).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWorkbook.SaveAs Filename:=FilName, FileFormat:= _
xlNormal, Password:=””, WriteResPassword:=””, ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Set Session = CreateObject(“Notes.NotesSession”)
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) – InStr(1, UserName, ” “))) & “.nsf”
Set Maildb = Session.GETDATABASE(“”, MailDbName)
If Maildb.IsOpen True Then
On Error Resume Next
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.form = “Memo”
stSignature = Maildb.GetProfileDocument(“CalendarProfile”) _
.GetItemValue(“Signature”)(0)
With MailDoc
.SendTo = recipient
.copyto = ccRecipient
.blindcopyto = bccRecipient
.subject = finlsub
.body = finlbody & vbCrLf & vbCrLf & stSignature
End With
MailDoc.SaveMessageOnSend = True
Attachment1 = FilName
If Attachment1 “” Then
Set attachME = MailDoc.CREATERICHTEXTITEM(“Attachment1”)
Set EmbedObj1 = attachME.EmbedObject(1454, “”, Attachment1, “Attachment”)
Set EmbedObj2 = attachME.EmbedObject(1454, “”, Attachment2, “Attachment”)
MailDoc.CREATERICHTEXTITEM (“Attachment”)
End If
MailDoc.PostedDate = Now()
MailDoc.send 0, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
finlsub = Null
finlbody = Null
Next
Sheets(“MAIL-ID”).Activate
Range(“A1”).Select
MsgBox “Thank you for using this MACRO”
End Sub