I have implemented a DragDrop functionality to my Excel database using TreeView control, using this code:
Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim StrPath As String
StrPath = Data.Files(1)
'path saved in UserForm label named "FilePathLB"
FilePathLB = StrPath
End Sub
It works perfectly fine on most of the machines I distributed the file to, however some machines with older versions of MS Office fire an error on the very first line (Private Sub ...) due to not being able to find Microsoft Windows Common Control library.
My question: is it possible to late bind this library and thereby preventing the error from happening?
Or at least, is it possible to add a debugger to prevent the error from showing, something like On Error Resume Next for the whole Sub? I understand that in this case the DragDrop function would not work, but it is better than an error.
For your last question:
Sub ()...
On Error GoTo ErrorHandler
'Your code
Exit Sub
ErrorHandler:
Msgbox "Could not load DragDrop function. Program execution has been terminated.", vbExclamation, "Error"
End Sub
If you want to, you could also just drop the MsgBox.
EDIT:
will not work as the code breaks on the first line.
Code below to support my comment. If an error occurs in the sub-macro, then the PassedSub variable won't be set to True, thus indicating an error.
Public PassedSub As Boolean
Sub test1()
On Error Resume Next
Call test2
If PassedSub = False Then GoTo ErrorHandler
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Could not load DragDrop function. Program execution has been terminated.", vbExclamation, "Error"
End Sub
Sub test2()
Debug.Print 2 / 0
PassedSub = True
End Sub
Related
I put together a VBA procedure that does the following:
opens a bunch of excel files (separately not at once) from a specific folder (user indicates the folder)
excel files are password protected so it inputs the password , opens the file , then unprotects a specific sheet (as sheets are also pass protected) and does some changes to the file.
My problem is that for the changes to be applied to each excel file the sheet has to be unprotected and there is unfortunately 3 different options for pass (dont ask me why). I know the pass options so i put it in my code as per below:
However the procedure still stops if the first pass option is incorrect and I have to manually drag the execution line to the next valid pass for the procedure to continue.
Essentially my questions are: is the code set up above ok and is there a way of making VBA to attempt another password to unprotect sheet if the first pass is not the correct one (and a third attempt if the 2nd pass is also incorrect)?
Uff, hope the above makes sense and thanks for reading
This should help. I haven't used any of your code as it's a picture that I can't copy/paste, but this should give you the idea.
Note:
Option Explicit should appear at the top of every module - forces you to declare variables.
the Public Const line must be at the top of a module before any procedures/functions.
Option Explicit
Public Const ERROR_SHEETPROTECTED As Long = vbObjectError + 513
Sub Test()
'Any errors should be handled by the error handler appearing after the Exit Sub.
On Error GoTo ERROR_HANDLER
Dim wrksht As Worksheet
With ThisWorkbook
Set wrksht = .Worksheets("Sheet1")
'Use each password and exit loop when correct one is found.
Dim PWDS As Variant
PWDS = Array("123", "456", "ABCD")
Dim PWD As Variant
For Each PWD In PWDS
On Error Resume Next 'Ignore any errors and move to next line.
wrksht.Unprotect PWD
On Error GoTo ERROR_HANDLER 'Reinstate correct error handling as soon as possible.
If Not wrksht.ProtectContents Then Exit For 'We found a match!
Next PWD
'Final check that at least one of the passwords worked.
If wrksht.ProtectContents Then
Err.Raise ERROR_SHEETPROTECTED, , "Password for sheet not found"
End If
End With
Exit Sub
'Error handling appears after the main body of code (Exit Sub) and before the end of the procedure (End Sub)
ERROR_HANDLER:
Select Case Err.Number
Case ERROR_SHEETPROTECTED
MsgBox Err.Number & vbCr & Err.Description, vbOKOnly + vbCritical
'Other code to sort the problem out.
Resume Next 'If problem is solved use this to jump back into the main code.
Case Else
MsgBox Err.Number & vbCr & Err.Description, vbOKOnly + vbCritical
End Select
End Sub
Raise method
With...End With Statement
On Error GoTo -1
There are a couple of misunderstandings in your code, because even if it succeeds first time it will run into the next error handler.
But the main error is a common misunderstanding in error handling when trying to handle multiple errors in a sequenz, missing the On Error GoTo -1 :
Option Explicit
Sub BadErrorHandlingSequenz()
Dim x As Integer
On Error GoTo Errhandler1
x = 3 / 0
Exit Sub
Errhandler1:
On Error GoTo errhandler2
x = 5 / 0 ' Error is not handled
Exit Sub
errhandler2:
MsgBox "Still Error"
End Sub
Sub GoodErrorHandlingSequenz()
Dim x As Integer
On Error GoTo Errhandler1
x = 3 / 0
Exit Sub
Errhandler1:
On Error GoTo -1 ' Reset Error handling
On Error GoTo errhandler2
x = 5 / 0 ' Error is handled
Exit Sub
errhandler2:
MsgBox "Still Error"
End Sub
I want to apply the error handling mechanism in Excel VBA, I want to catch this "runtime error 9", but it's not working.
I am using this userform_initialize() method/sub over and over again, each time I don't want to open this "SAMPLE UPDATE FILE.xlsm" workbook instead, I want to check if it's already open. if yes, then switch to that window or open that workbook.
I have tried on error resume next statement as well but still, it breaks on switching to window "Windows("SAMPLE UPDATE FILE.xlsm "). Select"
Private Sub UserForm_Initialize()
Application.DisplayAlerts = False
On Error GoTo OPEN_WB_ERR
Windows("SAMPLE UPDATE FILE.xlsm").Select
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
On Error GoTo 0
Exit Sub
OPEN_WB_ERR:
Workbooks.Open Filename:="X:\SAMPLE UPDATE FILE.xlsm"
UserForm1.ComboBox1.RowSource = ("'X:\SAMPLE UPDATE FILE.xlsm'!SEARCH")
Windows("PROFORMA_INVOICE.xlsm").Activate
Resume Next
End Sub
any advice will be helpful...
Check your setting in the VB editor (Tools >> Options >> General tab >> Error Trapping) for how errors are handled - if you have "Break on all errors" selected then it will always break regardless of any error handling you have set. "Break in Class module" is a good option.
Try,
Private Sub UserForm_Initialize()
Dim path As String, Fn As String
Dim Wb As Workbook
Fn = "X:\SAMPLE UPDATE FILE.xlsm"
Set Wb = Workbooks.Open(Filename:=Fn)
UserForm1.ComboBox1.RowSource = "'" & Fn & "'" & "!SEARCH"
ThisWorkbook.Activate
End Sub
The Initialize event procedure runs when the form is first created, before it is shown. You should open your workbook before creating the form, not as part of that process. Try a procedure like the one below, to be installed in a standard code module.
Sub OpenUserForm()
Dim MyForm As UserForm1
' open your workbook here
Set MyForm = New UserForm1 ' this fires the Initialize event
UserForm1.Show
' the code below runs when MyForm is closed
Unload MyForm
Set MyForm = Nothing
End Sub
Note that a form by the name of UserForm1 must exist. I recommend to give it another, more descriptive name. If you do that whatever name you give is the one to use in the Dim statement declaring MyForm.
I use a WorkbookIsOpen function
Public function WorkbookIsOpen(byval strFile as string) as Boolean
Dim wbkCurr as excel.workbook
WorkbookIsOpen = false
For each wbkCurr in application.Workbooks
If wbkCurr.name = strfile then
WorkbookIsOpen = true
Exit for
Endif
Next wbkCurr
End function
Pass just the file name and extension ie myworkbook.xlsx
Then I just adjust my logic accordingly
I wish to pause the execution of my VBA code once an error appears, and continue the execution when corrected?! Because I have a very long execution, so it always goes from the beginning...
you need to use an error handler. Something like
On Error GoTo errorTrap
at the beginning of your code directly after your dims and other setup.
Then for the actual errortrap you would write this before the End Sub.
The whole thing would look like this.
Sub test()
Dim v As Variant, x As Integer 'etc etc
On Error GoTo errorTrap
'run your code here. An example is below
x = "hello" 'this will create an error since hello is not an integer
MsgBox "finished"
End 'ignore the error trap when done
errorTrap:
Debug.Print Err.Description
Stop 'stop here and figure out what is going on.
'any other code needed to fix the error
Resume Next
End Sub
I have a script in Excel that sometimes can run for too long.
I need a simple method for the users to interrupt.
Right now the solution is to press the [esc] key than the [end] button.
I was wondering if it is possible, to get rid of this pop up window
Something like: if [esc] is pressed than a simple End (stop all scripts) would do the trick
EDIT3: So finally I found out what the problem was. There was a for loop after the do while, so the for did not stop. To solve this, I inserted a simple if - end function, inside the for loop.
I also accept mrbungle's solution because in his link I found a solution to stop the script without error message by pressing [esc]. Thank you for Your answer.
The working code.
Option Explicit
Dim StopCode As Boolean 'Global bool
Sub mysub_Click()
Dim c As Range
Dim p As String
Dim lastonline As Object
Dim x: Dim y
Dim actives As String
Dim timeoutc As Variant
actives = ActiveSheet.Name
timeoutc = 0
StopCode = False
Application.EnableCancelKey = xlErrorHandler
On Error GoTo ErrH:
DoEvents
For Each c In Sheets(actives).UsedRange.Cells
If StopCode = True Then
Exit For
End If
{The code} 'I have deleted it so it is less confusing now
next c
ErrH:
If Err.Number = 18 Then
Debug.Print "break key hit"
Else
Debug.Print "other error: "; Err.Number, Err.Description
End If
End Sub
The userform
Option Explicit
Dim StopCode As Boolean 'Global bool
Private Sub CommandButton1_Click() 'close button
PTimeout.Hide
End Sub
Private Sub CommandButton2_Click() 'stop script button (does not work)
StopCode = True
PTimeout.Hide
End Sub
Chip Pearson has a great solution here that I believe solves your problem. I'll explain it in a nutshell in case the link is ever broken. This would go in your code and on the sheet in question you would create a command button and assign another sub that would set StopCode to True. When user clicks the button, StopCode would be set to True, code stops running.
StopCode = False
Do Until StopCode = True
DoEvents
' your code here. next line is just an example
I have written a VBA program which creates, on Workbook_Open, a file stream that writes errors to an error log. If I run into a fatal error (and therefore need to halt execution of the macro), the program executes an End statement, abruptly halting the macro. I know that this solution is not an ideal one, but I can't see a better way to end things quickly if I'm several functions deep (i.e., one function has called another which has called yet another, and the third function produces the error). Exiting the function in which the error occurred will only affect that particular function, leading to the possibility of invalid data, unexpected cell values, etc.
But this approach leads me to another problem -- when End executes it destroys all of my objects, including the error stream. So when the user does something new and runs across a fatal error, they get a VBA runtime error (91: Object ... not set) because the code writes to the file stream that's now set to Nothing.
Is there a better way to end the macro (and thus avoid unexpected behaviour after an error) without losing all of my objects? The official VBA documentation is of no help. Thanks in advance.
End:
Terminates execution immediately. Never required by itself but may be
placed anywhere in a procedure to end code execution, close files
opened with the Open statement and to clear variables. When executed,
the End statement resets all module-level variables and all static
local variables in all modules.
ThisWorkbook module:
Public fileSystem As FileSystemObject
Public errorStream As TextStream
Private Sub Workbook_Open()
Set fileSystem = New FileSystemObject
Set errorStream = fileSystem.CreateTextFile("c:\temp\error.log", True)
End Sub
Standard module:
Public Sub First()
If (Not ThisWorkbook.errorStream Is Nothing) Then
Debug.Print VBA.TypeName(ThisWorkbook.errorStream)
End If
End
' Exit Sub
End Sub
Public Sub Second()
If (Not ThisWorkbook.errorStream Is Nothing) Then
Debug.Print VBA.TypeName(ThisWorkbook.errorStream)
End If
End Sub
When 'First' method executes first with 'End' in it and then 'Second' method, then errorStream will be Nothing. Instaead of 'End' use 'ExitSub', then the variable will not be reset.
Or you could make error-stream variable private in Thisworkbook class module and add property, which will create the stream if the variable is Nothing. HTH
ThisWorkbook module:
Private m_errorStream As TextStream
Private Const FILE_PATH_NAME As String = "c:\temp\error.log"
Public Property Get ErrorStream() As TextStream
If (m_errorStream Is Nothing) Then
Dim fileSystem As FileSystemObject
Set fileSystem = New FileSystemObject
If (fileSystem.FileExists(FILE_PATH_NAME)) Then
Set m_errorStream = fileSystem.GetFile(FILE_PATH_NAME).OpenAsTextStream
Else
Set m_errorStream = fileSystem.CreateTextFile(FILE_PATH_NAME, False)
End If
End If
Set ErrorStream = m_errorStream
End Property
Standard module:
Public Sub First()
If (Not ThisWorkbook.ErrorStream Is Nothing) Then
Debug.Print VBA.TypeName(ThisWorkbook.ErrorStream)
End If
End
End Sub
Public Sub Second()
If (Not ThisWorkbook.ErrorStream Is Nothing) Then
Debug.Print VBA.TypeName(ThisWorkbook.ErrorStream)
End If
End Sub
Declare your variables on the module-level, not in the function. In VBA, you see the various sheets on the Project navigation on the left by default. Below the sheets is a folder called "Modules": if you don't see a "Module1" or variant as a child of this folder, right-click the folder and select "Insert\Module."
These should be persistent for you.
Maybe try Exit instead of End?
If you are trying to exit from a function
Function a()
If blahblah.. Then
Exit Function
End If
End Function
I am unsure of how your objects are declared and handled on what modules so... if you can post the code, it may help greatly.
use a top level error handler, and only trap errors in routines you want to handle without aborting completely
Demo:
Option Explicit
Sub test()
On Error GoTo Top_Error_Handler
Debug.Print "Error handled in sub routine: test1"
test1
Debug.Print "Error NOT handled in sub routine: test2"
test2
Exit Sub
Top_Error_Handler:
MsgBox "Top Level Error Handler: Error Number:" & Err.Number _
& ":" & Err.Description
End Sub
Sub test1()
On Error Resume Next
Debug.Print 1 / 0
End Sub
Sub test2()
Debug.Print 1 / 0
End Sub
As you can see, the error handling in test1 overrides the handling in the main program, so no error is raised. In the second Sub, test2, there is no error handling, so the information is passed up to the previous program to handle (and it will pass it up the chain, if that program was called by something else), and the error can be cleanly handled by your main routine to close everything tidily.