This should be really easy but I can't find it out.
Im trying to do a loop for saving the form records every minute. Which works but when I close the form the macro keeps running and eventually returns a unwanted error because form is no longer open:
BASIC runtime error.
An exception occurred
Type: com.sun.star.lang.DisposedException
Message: Frame disposed.
This is my macro
Sub Save_loop
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Do Until '???window is closed
dispatcher.executeDispatch(document, ".uno:RecSave", "", 0, Array())
wait 60000
Loop
End Sub
What can I put on the While/Until for not returning this error?
userForm_QueryClose() event should work
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
is_closed = 1
End Sub
Sub Save_loop
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Do Until '???window is closed
If (is_closed = 1) Then break
dispatcher.executeDispatch(document, ".uno:RecSave", "", 0, Array())
wait 60000
Loop
End Sub
Related
I have a workbook with userforms to write to several numeric and date fields. I need to validate the textbox control for proper numbers and dates.
Rather than replicate the validation for each textbox, I thought I would call a common subprocedure within the BeforeUpdae event of each textbox.
I have two problems.
If I execute the form and test using text in tbAmount box, it seems the ContolValidate procedure is not called.
If I run it in break mode with a breakpoint on Call ContolValidate(What, CurrentControl), it will step through that procedure.
Even though it steps through the procedure, the Cancel = True does not seem to work.
If I paste the ContolValidate code directly in the BeforeUpdate, the Cancel = True does work.
This code is all on the userform.
Private Sub tbAmount1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim What As String
Dim CurrentControl As Control
What = "NumericField"
Set CurrentControl = Me.ActiveControl
Call ContolValidate(What, CurrentControl)
End Sub
Private Sub ContolValidate(What, CurrentControl)
If Not IsNumeric(CurrentControl.Value) Then
ErrorLabel.Caption = "Please correct this entry to be numeric."
Cancel = True
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
Else
If CurrentControl.Value < 0 Then
ErrorLabel.Caption = "This number cannot be negative."
Cancel = True
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
End If
End If
End Sub
Private Sub tbAmount1_AfterUpdate()
ErrorLabel.Visible = False
tbAmount1.BackColor = Me.BackColor
End Sub
(1) When your control is named tbAmount1 and the code is in the code-behind module of the form, the trigger should fire.
(2) As #shahkalpesh mentioned in his comment, Cancel is not known in your validate-routine. Putting Option Explicit at the top of you code would show you that.
I would suggest to convert the routine to a function. In the code below, I return True if the content is okay and False if not (so you need to put a Not to the result to set the Cancel-parameter)
Private Sub tbAmount1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = Not ControlValidate("NumericField", Me.ActiveControl)
End Sub
Private Function ControlValidate(What, CurrentControl) As Boolean
ControlValidate = False
If Not IsNumeric(CurrentControl.Value) Then
errorlabel.Caption = "Please correct this entry to be numeric."
ElseIf CurrentControl.Value < 0 Then
errorlabel.Caption = "This number cannot be negative."
Else
ControlValidate = True ' Input is okay.
End If
If ControlValidate Then
CurrentControl.BackColor = vbWhite
Else
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
End If
End Function
P.S.: I changed the name to ControlValidate - "contol" seems wrong to me...
I want to make a rest call [post/get] from excel macro from background . The macro should execute silently for every 5sec. If rest call gets valid response, show some message to user.
Note: When macro is running in the background Async , it should not interrupt the user experience on excel
I have used call back method, but the problem is excel is slow as the macro which makes rest call runs continuously at the background. Below is the code FYR.
'MyReadyStateHandler class module
Sub OnReadyStateChange()
DoEvents
If Actions.docx.readyState = 4 Then
If Actions.docx.Status = 200 Then
IsReadyState = True
outPutText = Actions.docx.responseText
Exit Sub
Else
IsReadyState = False
Exit Sub
End If
End If
End Sub
_________________________
'Sub using MyReadyStateHandler
Public sub TestRestServiceStatus()
Set MyOnReadyStateWrapper = New MyReadyStateHandler
Set docx = New MSXML2.XMLHTTP60
docx.OnReadyStateChange = MyOnReadyStateWrapper
docx.Open "POST", urlString, False
docx.send jsonBody
responceStatus = MyOnReadyStateWrapper.IsReadyState
If (responceStatus = True) Then
Dim notificationOutPut As String
notificationOutPut=MyOnReadyStateWrapper.outPutText
If InStr(notificationOutPut , "PROCESSING") > 0 Then
Call TestRestServiceStatus
ElseIf InStr(notificationOutPut , "COMPLETE") > 0 Then
'Notify User on Excel
EndIF
EndIf
End sub
I've got an UserForm, which upon an incorrect user input calls the following procedure, which highlights the field and disables the "save changes" button.
Private disabledElems As New Collection
Private Sub disable(ByRef controlName As String)
UserForm1.Controls(controlName).BackColor = &H8080FF
Me.save_button.Enabled = False
Dim i As Byte
If disabledElems.Count <> 0 Then
For i = 1 To disabledElems.Count
If disabledElems(i) = controlName Then
Exit Sub ' we dont want to add duplicates to collection
End If
Next i
End If
disabledElems.Add controlName ' otherwise add to collection
End Sub
If the input is corrected, it calls the enable procedure, which looks like this:
Private Sub enable(ByRef controlName As String)
Me.Controls(controlName).BackColor = &H80000005
Dim i As Byte
For i = 1 To disabledElems.Count
If disabledElems(i) = controlName Then
disabledElems.Remove i ' remove the enabled element upon match
End If
Next i
If disabledElems.Count = 0 Then
save_button.Enabled = True
End If
End Sub
This seems to work just fine when I try this with one Textbox
However, as soon I have multiple incorrect entries, my enable procedure seems to throw a Subscript out of range error seemingly for no reason.
The highlighted line in the debugger is:
If disabledElems(i) = controlName Then
I can't comprehend what could be causing this. Any ideas?
Ah alright, it's one of those classical "when removing a row, loop
from end to beginning"
Basically, the reason why the Subscript out of range was thrown - once the element was removed from the collection via the
disabledElems.Remove i
It reduced the size of the Collection from Collection.Count to Collection.Count - 1, however during the for loop declaration, the i was already hard-set to the previous Collection.Count
In an practical example:
Let's say my Collection looks like this
disabledElems = "button1", "button2"
Upon doing this
controlName = "button1"
For i = 1 to disabledElems.Count ' <= 2
If disabledElems(i) = controlName ' < True for i = 1
disabledElems.Remove i ' < button1 was removed from collection, however it still loops
End If
' will loop to i = 2. However disabledElems(2) no longer exists, because upon removal _
the button2 was shifted to disabledElems(1) - hence Subscript out of range
Next i
A clear case of trying to access an element, which has shifted its position in the queue.
There are two possible fixes (that I can think of):
1. Enforce Exit Sub upon removal
For i = 1 to disabledElems.Count
If disabledElems(i) = controlName
disabledElems.Remove i
Exit Sub
End If
Next i
2. Loop from end to start
Dim i as Integer ' needs to be redeclared to int, because Byte can't -1
For i = disabledElems.Count to 1 Step -1
If disabledElems(i) = controlName
disabledElems.Remove i
End If
Next i
I have the following piece of code
Do
On Error Resume Next
.FindElementById("ContentPlaceHolder1_DropDownListl2").AsSelect.SelectByText ("txt")
On Error GoTo 0
Loop Until .FindElementById("ContentPlaceHolder1_DropDownListl2").AsSelect.SelectedOption.Text = "txt"
I have a lot of drop down lists that I deal with them with the same approach and although I used On Error Resume Next, I got errors sometimes and I have to wait a little and click Resume to resume the code execution
Can I make this as public procedure as I will use such lines a lot with other elements?
And how I can avoid the errors? and of course at the same time get my target for selecting the desired text in the drop down
Here's a snapshot of one of the errors
Based on #QHarr reply I tried to make a public procedure like that
Sub WaitElement(driver As Selenium.WebDriver, sElement As SelectElement, txt As String)
Dim t As Date
Const MAX_SEC As Long = 30
With driver
On Error Resume Next
t = Timer
Do
DoEvents
sElement.AsSelect.SelectByText txt
If Timer - t > MAX_SEC Then Exit Do
Loop Until sElement.AsSelect.SelectedOption.Text = txt
On Error GoTo 0
End With
End Sub
But when trying to use it in that way
WaitElement bot, .FindElementById("ContentPlaceHolder1_DropDownListnat"), ws.Range("B11").Value
I got 'Run-time error 13' (Type mismatch)
After applying the UDF named 'TextIsSet' I got this error
and the same problem.. if I click on Debug then Resume then wait a little, the code resumes its work
I have used such lines too but doesn't help
Do
Loop While .FindElementsById("ContentPlaceHolder1_Dschool").Count = 0
I got the same last error of not founding such an element
This can happen when an action causes a change to the DOM. The lazy way is to add a timed loop to try for that element until that error goes away or time out reached. You could also try shifting the On Error to surround the loop instead of inside the loop and then add in a time out. This is a little brutal but without a webpage to test with.
As a function call (this feels ugly and you may find webElements don't like being passed around):
Option Explicit
Public Sub test()
Const MAX_WAIT_SEC As Long = 30
'other code
If TextIsSet(dropdown, expectedText, MAX_WAIT_SEC) Then
End If
End Sub
Public Function TextIsSet(ByRef dropdown As Object, ByVal expectedText As String, ByVal MAX_WAIT_SEC As Long) As Boolean
Dim t As Date
On Error Resume Next
t = Timer
Do
DoEvents
dropdown.AsSelect.SelectByText expectedText
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop Until dropdown.AsSelect.SelectedOption.Text = expectedText
If dropdown.AsSelect.SelectedOption.Text = expectedText Then
TextIsSet = True
Else
TextIsSet = False
End If
On Error GoTo 0
End Function
I don't have a stale element test case so I just used a drop down test case:
Option Explicit
Public Sub test()
Const MAX_WAIT_SEC As Long = 30
Dim d As WebDriver, expectedText As String, dropdown As Object
'expectedText = "AL - Alabama" ''Pass Case
expectedText = "Bananaman" 'Fail Case
Set d = New ChromeDriver
With d
.get "https://tools.usps.com/zip-code-lookup.htm?byaddress"
Set dropdown = .FindElementById("tState")
'other code
If TextIsSet(dropdown, expectedText, MAX_WAIT_SEC) Then
Debug.Print "Tada"
Else
Debug.Print "Sigh"
End If
.Quit
End With
End Sub
Public Function TextIsSet(ByRef dropdown As Object, ByVal expectedText As String, ByVal MAX_WAIT_SEC As Long) As Boolean
Dim t As Date
On Error Resume Next
t = Timer
Do
DoEvents
dropdown.AsSelect.SelectByText expectedText
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop Until dropdown.AsSelect.SelectedOption.Text = expectedText
If dropdown.AsSelect.SelectedOption.Text = expectedText Then
TextIsSet = True
Else
TextIsSet = False
End If
On Error GoTo 0
End Function
Option Explicit
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Dim status As String
Sub StartModule()
Dim index As Integer
Dim result As String
Dim o: Set o = CreateObject("NAddIn.Functions")
status = ""
Do Until status = "DADA"
result = o.getRandomNumber
Range("F2").Value = result
Sleep123
If status = "EXIT" Then Exit Do
Loop
End Sub
Sub StopModule()
status = "EXIT"
End Sub
Sub Sleep123()
Sleep 1000 'Implements a 1 second delay
End Sub
This vba script is calling called getRandomNumber() which is a user defined function in dll file. After running by clicking start button, I am able to run the function which continuously generates a random number and shows in a cell .
The problem is I'm unable to click stop button or edit any cell and even I cannot close the xl file.
Don't use the Sleep API. The Sleep function not only suspends the execution of the current thread for a specified interval but also will not let you do anything else. i.e it will freeze Excel. Use this custom function Wait that I created many years ago.
Option Explicit
Dim status As String
Sub StartModule()
Dim index As Integer
Dim result As String
Dim o: Set o = CreateObject("NAddIn.Functions")
status = ""
Do Until status = "DADA"
result = o.getRandomNumber
Range("F2").Value = result
Wait 1 '<~~ Wait for a second
If status = "EXIT" Then Exit Do
Loop
End Sub
Sub StopModule()
status = "EXIT"
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
BTW, it's not a good idea editing cells when you have set a timer to 1 second. When you are in the edit mode, you will get an error as Excel will not be able to write to cell F2. Consider increasing the timer in such a case :)