Cannot cancel a BackgroundWorker procss - vb.net

I have a BackgroundWorker that includes a class ExcelOutput, used to output various data to a workbook, and I should mention straight away that bw.WorkerSupportsCancellation = True is set.
At each stage of the output I'm checking for errors in ExcelOutput using Try/Catch, and if necessary displaying an error (using a function called ErroReport().
In conjunction with the error message, I want to cancel the BackgroundWorker to avoid further errors. To that end I have added the OutputWorker property to the ExcelOutput class and I set that to be a copy of my BackgroundWorker in the bw_DoWork() method.
However, the cancellation carried out in ExcelOutput.ErroReport() is not working, and I don't know why.
Note that I've tested the value of bw.CancellationPending and it is set to True after an error. I've also tested that the If condition following is working by showing a message box, and that also works. For some reason it seems as though the Exit Sub command is ignored though.
Can anyone suggest what I am doing wrong? Thanks.
Here is how the bw_DoWork() function from the BackgroundWorker class is set up -
Private Sub bw_DoWork(ByVal sender As Object,
ByVal e As DoWorkEventArgs)
Dim Excel As New ExcelOutput ' Create a new instance of the ExcelOutput class
Dim CurrentRow As Integer = 4 ' Set the first output row
'** Include a copy of the OutputWorker in the ExcelOutput (so that the OutputWorker can be cancelled)
Excel.OutputWorker = Me
If bw.CancellationPending = True Then
e.Cancel = True
Exit Sub
Else
Excel.Prepare()
End If
If bw.CancellationPending = True Then
e.Cancel = True
Exit Sub
Else
CurrentRow = Excel.OutputGroup("General", Headers, Data, 4)
End If
' More stuff here...
End Sub
Here is how the ErrorReport() function from the ExcelOutput class is set up -
Private Sub ErrorReport(ByVal Ex As Exception,
Optional ByVal CustomMessage As String = "")
Call Me.ResetRange() ' Destroy the 'Range' object
Dim ErrorMessage As String = "Message: " & Ex.Message ' Set the default message
If CustomMessage <> "" Then ErrorMessage = CustomMessage & vbCrLf & vbCrLf & Ex.Message
Dim Result As Integer = MessageBox.Show(ErrorMessage,
"An Error Has Occured",
MessageBoxButtons.OK,
MessageBoxIcon.Stop)
'** Close the workbook (if it's open) and stop the OutputWorker *'
Try
Call Me.WB.Close(SaveChanges:=False)
If Me.OutputWorker.WorkerSupportsCancellation = True Then
Me.OutputWorker.CancelAsync()
End If
Catch
End Try
End Sub

You should try to add the DoWorkEventsArgs as parameter to your ErrorReport function.
Private Sub ErrorReport(ByVal Ex As Exception,
Optional ByVal CustomMessage As String = "",
ByVal e As DoWorkEventsArgs)
Call Me.WB.Close(SaveChanges:=False)
If e.WorkerSupportsCancellation = True Then
e.CancelAsync()
End If
You'll be able to cancel the Backgroundworker.

Related

How can I fix a run-time error when capturing text from a textbox in a form?

I am trying to capture the value entered into the text box of a form instance which was created using the following module code:
Public myForm As Form_Form1
'Dim myForm As Form_Form1 ' tried this
Sub test()
'Dim myForm As New Form_Form1 ' tried this
Set myForm = New Form_Form1
With myForm
.Visible = True
' .SetFocus ' tried this
' .Modal = True ' tried this
If .IsCancelled Then
Exit Sub
End If
Debug.Print .RptDt
End With
The form is very basic with an OK and Cancel button and a single text box named Text7. The form code-behind is:
Private cancelling As Boolean
Public Property Get RptDt() As String
RptDt = Text7.Text
End Property
Public Property Get IsCancelled() As Boolean
IsCancelled = cancelling
End Property
Private Sub Command2_Click()
'DoCmd.Close acForm, Me.Name
Me.Visible = False
'Me.Visible
End Sub
Private Sub Command4_Click()
cancelling = True
'DoCmd.Close acForm, Me.Name
'MsgBox Me.Name
'MsgBox Me.OpenArgs
'Me.Hide
Me.Visible False
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = VbQueryClose.vbFormControlMenu Then
cancelling = True
Me.Visible = False
End If
End Sub
When I run the code as is I get:
"Run-time error '2185' You can't reference a property or method for a control unless the control has the focus"
I have also tried:
Public Property Get RptDt() As String
RptDt = Text7.Value
End Property
I then get Run-time error '94' Invalid use of null. The code above was modified from a comparable Excel VBA code which uses the Userform Show method (only works in Excel) in the Sub Test() instead of .Visible = True.
Just a side point, but on the Command4_Click event change the below line to add an equals:
Me.Visible = False
This can change the syntax and is a different function to the one intended.
The .Text property can only be called when a Control has the focus. Similarly, a null exception will be called if you use .Value in it's place when the textbox is empty.
There are two ways around this:
Option 1 - Handling the NULL value
Public Property Get RptDt() As String
If IsNull(Text7.Text) = True Then
RptDt = "EmptyString" 'Or whatever string you want to set this to
Else
RptDt = Text7.Text
End if
End Property
Option 2 - Setting the focus
Public Property Get RptDt() As String
Text7.SetFocus
RptDt = Text7.Text
End Property

How to prevent a local resource assigments on a task by event handler?

I want to prevent local resources from being assigned to tasks.
Only corporate resources must be assigned.
How to implement this at the time of assignments by event handler?
This can be done with Application Events. Because assignments can be modified directly in a task table and in the Task Information dialog box, two event handlers are required. Create a class module called Events with the following code:
Option Explicit
Public WithEvents App As Application
Private Sub App_ProjectBeforeAssignmentChange(ByVal asg As Assignment, ByVal Field As PjAssignmentField, ByVal NewVal As Variant, Cancel As Boolean)
If Field = pjAssignmentResourceName Then
If Not ThisProject.Resources(NewVal).Enterprise Then
MsgBox "Resource '" & NewVal & "' cannot be added.", vbOKOnly, "Only enterprise resources are allowed"
Cancel = True
End If
End If
End Sub
Private Sub App_ProjectBeforeTaskChange(ByVal tsk As Task, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
If Field = pjTaskResourceNames Then
Dim resNames() As String
resNames = Split(NewVal, ",")
Dim AllEnterprise As Boolean
AllEnterprise = True
Dim i As Integer
For i = 0 To UBound(resNames)
AllEnterprise = AllEnterprise And ThisProject.Resources(resNames(i)).Enterprise
Next i
If Not AllEnterprise Then
MsgBox "Resource Names '" & NewVal & "' is invalid.", vbOKOnly, "Only enterprise resources are allowed"
Cancel = True
End If
End If
End Sub
In the ThisProject module, add this code:
Option Explicit
Dim eClass As New Events
Private Sub Project_Open(ByVal pj As Project)
InitializeEventHandler
End Sub
Sub InitializeEventHandler()
Set eClass.App = Application
End Sub

Excel VBA: Compile Error: Method or data member not found

EDIT: To clarify, the code seen below is within a module and the UserForm is all contained within its own code.
I have the following code. When I go to run it, Excel throws me a compile error: Method or data member not found and highlights the following piece of code: .showInputsDialog. I have no idea how to resolve this error.
To give more information, the sub sportUserForm is supposed to call up a UserForm sportsUsrFrm. Any help with this issue is greatly appreciated.
Option Explicit
Sub sportUserForm()
Dim sSport As String, sPreference As String
If sportsUsrFrm.showInputsDialog(sSport, sPreference) Then
MsgBox "Your favorite sport is " & sSport & ", and you usually " _
& sPreference & "."
Else
MsgBox "Sorry you don't want to play."
End If
End Sub
Public Function showInputsDialog(sSports As String, sPreference As String) As Boolean
Call Initialize
Me.Show
If Not cancel Then
If optBaseball.Value Then sSport = "Baseball"
ElseIf optBasketball.Value Then sSport = "Basketball"
Elss sSport = "Football"
End If
If optTV.Value Then sPreference = "watch on TV" _
Else: sPreference = "go to games"
End If
showInputsDialog = Not cancel
Unload Me
End Function
UserForm code for sportUsrFrm
Option Explicit
Private Sub cmdCnl_Click()
Me.Hide
cancel = True
End Sub
Private Sub cmdOK_Click()
If Valid Then Me.Hide
cancel = False
End Sub
You're getting the error because showInputsDialog isn't a member of the form, it's a member of the module you're calling it from. You should also be getting compiler errors on these two lines...
Call Initialize
Me.Show
...because you seem to be getting the module and form code mixed up.
That said, you're overthinking this. A UserForm is a class module, and it can be stored in a variable (or in this case, in a With block), and can have properties. I'd add a Cancelled property to the form:
'In sportsUsrFrm
Option Explicit
Private mCancel As Boolean
Public Property Get Cancelled() As Boolean
Cancelled = mCancel
End Property
Private Sub cmdCnl_Click()
Me.Hide
mCancel = True
End Sub
Private Sub cmdOK_Click()
If Valid Then Me.Hide '<-- You still need to implement `Valid`
End Sub
And then call it like this:
Sub sportUserForm()
With New sportsUsrFrm
.Show
Dim sSport As String, sPreference As String
If Not .Cancelled Then
If .optBaseball.Value Then
sSport = "Baseball"
ElseIf .optBasketball.Value Then
sSport = "Basketball"
Else
sSport = "Football"
End If
If .optTV.Value Then
sPreference = "watch on TV"
Else
sPreference = "go to games"
End If
MsgBox "Your favorite sport is " & sSport & ", and you usually " _
& sPreference & "."
Else
MsgBox "Sorry you don't want to play."
End If
End With
End Sub

visual basic Function to return exit sub

I am creating a visual basic application for a friend. Anyway I am trying to create a function that returns "exit sub" to the sub calling the function. I have seen some ways around this by returning a value like 1 or 2 and inserting a if in calling sub. just wondering if there is a short hand for returning exit sub that I haven't learned yet.
Private Sub Button1.click() Handles Button1.Click
tryactive()
endsub
Private Function tryactive()
Try
AppActivate("your aplication")
Catch ex As Exception
Dim msgboxresponse = MsgBox("please start your application", 0, "Can't find your application")
If msgboxresponse = MsgBoxResult.Ok Then
Exit Sub <------ this is the problem i want to send this back to calling sub
End If
End Try
End Function
Code is much bigger and a lot more buttons. That's why i'm asking if there's a better way to do this. Any help is appreciated.
First of all, you cannot use an Exit Sub inside a Function. It should be an Exit Function. But based on what you want to happen (I guess), try this.
Private Sub Button1_Click() Handles Button1.Click
If TryActive() = False Then
Exit Sub
End If
'Your code you want to execute if TryActive() is True
End Sub
Private Function TryActive() as Boolean
Try
AppActivate("your aplication")
Return True
Catch ex As Exception
Dim msgboxresponse = MsgBox("please start your application", 0, "Can't find your application")
If msgboxresponse = MsgBoxResult.Ok Then
Return False
End If
End Try
End Function

msgbox that disappears automatically after certain time

Is there any type of msgbox in vb.net that gives a message and it disappears automatically after a certain time?
Or is there any method to hide the msgbox, without user's clicking OK?
You Can use
CreateObject("WScript.Shell").Popup("Welcome", 1, "Title")
this msgbox will close automatically after 1 second
No, I don't think there's a built-in framework control that will do this for you. However, you could easily do this with a custom-built form that fires a timer in it's Load event. Then, when the set amount of time has passed, in the timer Elapsed event, you can simply close the form.
Linendra Soni's answer is good, but it may or may not work in the newer versions of Windows and/or Excel.
This works perfectly in the newer versions:
Function MessageTimeOut(sMessage As String, sTitle As String, iSeconds As Integer) As Boolean
Dim Shell
Set Shell = CreateObject("WScript.Shell")
Shell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""" & sMessage & """," & iSeconds & ",""" & sTitle & """))"
MessageTimeOut = True
End Function
Use it like this:
Sub Example()
Dim chk As Boolean
chk = MessageTimeOut("Hello!", "Example Sub", 1) 'if chk returned FALSE that means the function was not executed successfully
End Sub
or
Sub Example()
Call MessageTimeOut("Hello!", "Example Sub", 1) 'you don't need to get the output of the function
End Sub
Output:
Use a timer or some type of delay/sleep and after time expires run
SendKeys.Send("~")
This is the same has hitting the ENTER key.
You may need to make it proceed it by activating the msgbox window again.
Inspired by the answers, this is what I came with, working nicely in simple cases, allowing to use all MsgBox features directly:
Imports System.Threading
Module FormUtils
Private sAutoClosed As Boolean
Private Sub CloseMsgBoxDelay(ByVal data As Object)
System.Threading.Thread.Sleep(CInt(data))
SendKeys.SendWait("~")
sAutoClosed = True
End Sub
Public Function MsgBoxDelayClose(prompt As Object, ByVal delay As Integer, Optional delayedResult As MsgBoxResult = MsgBoxResult.Ok, Optional buttons As MsgBoxStyle = MsgBoxStyle.ApplicationModal, Optional title As Object = Nothing) As MsgBoxResult
Dim t As Thread
If delay > 0 Then
sAutoClosed = False
t = New Thread(AddressOf CloseMsgBoxDelay)
t.Start(delay)
MsgBoxDelayClose = MsgBox(prompt, buttons, title)
If sAutoClosed Then
MsgBoxDelayClose = delayedResult
Else
t.Abort()
End If
Else
MsgBoxDelayClose = MsgBox(prompt, buttons, title)
End If
End Function
End Module
PS: You must add this to yourApp.config file:
<appSettings>
<add key="SendKeys" value="SendInput"/>
</appSettings>
I dont think there is a tool such as that. But I think you can do that with follow this steps;
Create an instance of Form element, and design it like a messagebox.
In Form load event, get the system time or start the timer with interval value.
This timer tick how many seconds you want then call the Form Close event.
P.S : If I'm wrong, I'm sorry. I only try to solve something, maybe there is a better way to solve your problem.
You can do this by adding a Timer to your form.
'Timer to autoclose after 100 ms
Dim seconds As Integer = 100
'Existing code....
Timer1.Start()
MessageBox.Show("Window Timed Out", "TimeOut")
Me.Close()
'Tick Event Code
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles Timer1.Tick
seconds = seconds - 1
If seconds < 1 Then`
Me.Close()
End If
End Sub
I have some code to show file updated time and close message box within 3 sec.
Please see below.
I hope that this code can support this topic.
Sub Workbook_Open()
Application.ScreenUpdating = False
SplashUserForm.Show
Windows(ThisWorkbook.Name).Visible = True
Application.ScreenUpdating = True
last_update = "Last updated : " & Format(FileDateTime(ThisWorkbook.FullName), "ddd dd/mm/yy hh:mm ampm")
'Close message after time if no action!
Dim myTimedBox As Object
Dim boxTime%, myExpired%, myOK%, myQuestBox%
'Access timed message box.
Set myTimedBox = CreateObject("WScript.Shell")
boxTime = 3
'User Selected "OK."
If myQuestBox = 1 Then
'Add any code in place of code below for this condition!
myOK = myTimedBox.Popup(last_update & vbCr & "Do nothing and this message will close in 3 seconds.", _
boxTime, "You Took Action!", vbOKOnly)
Else
'User took no Action!
myExpired = myTimedBox.Popup(last_update & vbCr & "Do nothing and this message will close in 3 seconds.", _
boxTime, "No Action Taken!", vbOKOnly)
End If
End Sub
This is the way
http://www.vbforums.com/showpost.php?p=3745046&postcount=5