The following code works as intended when I open word then open my test document. However, if I open the test document to start the first instance of Word, the timer kicks off while Word is loading up. Word then sits at loading till the timer runs out, document closes and a empty Word application is opened. The intended operation is open document; if idle for set time, save and close document.
I have users that share a document and same have a bad habit of locking their computer with the doc open, locking the file from anyone else editing it.
the goal of this is to save the file and close the doc after x time.
Private Sub Document_open()
StartCheckingIdle
End Sub
The TIMEOUTTIME below is set to 5 seconds for testing, but set it to 5 min say, and the document just sits at loading for that five minutes if Word was not open prior to double clicking the document to open.
Option Explicit
'Set the constant below for how long you want it to be idle before triggering
' Enter the time in hours:minutes:seconds form, like "00:30:00" for 30 minutes
Private Const TIMEOUTTIME As String = "00:00:05"
Private Declare Function GetQueueStatus Lib "user32" (ByVal fuFlags As Long) As Long
Private Const QS_KEY = &H1
Private Const QS_MOUSEMOVE = &H2
Private Const QS_MOUSEBUTTON = &H4
Private Const QS_MOUSE = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT = (QS_MOUSE Or QS_KEY)
Private bCancel As Boolean
Private Sub WaitForIdle()
Dim t As Double
t = Now
Do While bCancel = False
If GetQueueStatus(QS_INPUT) Then
t = Now
DoEvents
End If
If Now - t >= TimeValue(TIMEOUTTIME) Then Exit Do
Loop
End Sub
Public Sub StartCheckingIdle()
Do Until bCancel
WaitForIdle
If bCancel = False Then
bCancel = True
ThisDocument.Close True
End If
Do Until GetQueueStatus(QS_INPUT) Or bCancel
DoEvents
Loop
Loop
End Sub
Public Sub StopCheckingIdle()
bCancel = True
End Sub
Currently trying to get working on a Word doc, but eventually will need to apply this to an excel file as well.
Yes, I burrowed this code from another question on here, though I think it might be slightly outdated. I am running Office 2010.
May try to check for an active window first in your document.
Private Sub Document_Open()
Do While Application.ActiveWindow.Active = False
DoEvents
Loop
MsgBox "Open"
End Sub
Related
There is a sub, it creates a CourtForm userform and then takes a data from it. The problem appears when said form is closed prematurely, by pressing "X" window button and I get a runtime error somewhere later. For reference, this is what I'm talking about:
In my code I tried to make a check to exit sub:
Private Sub test()
'Create an exemplar of a form
Dim CourtForm As New FormSelectCourt
CourtForm.Show
'The form is terminated at this point
'Checking if the form is terminated. The check always fails. Form exists but without any data.
If CourtForm Is Nothing Then
Exit Sub
End If
'This code executes when the form proceeds as usual, recieves
'.CourtName and .CourtType variable data and then .hide itself.
CourtName = CourtForm.CourtName
CourtType = CourtForm.CourtType
Unload CourtForm
'Rest of the code, with the form closed a runtime error occurs here
End Sub
Apparently the exemplar of the form exists, but without any data. Here's a screenshot of the watch:
How do I make a proper check for the form if it's closed prematurely?
Add the following code to your userform
Private m_Cancelled As Boolean
' Returns the cancelled value to the calling procedure
Public Property Get Cancelled() As Boolean
Cancelled = m_Cancelled
End Property
Private Sub UserForm_QueryClose(Cancel As Integer _
, CloseMode As Integer)
' Prevent the form being unloaded
If CloseMode = vbFormControlMenu Then Cancel = True
' Hide the Userform and set cancelled to true
Hide
m_Cancelled = True
End Sub
Code taken from here. I would really recommend to have a read there as you will find a pretty good basic explanation how to use a userform.
One of the possible solutions is to pass a dictionary to the user form, and store all entered data into it. Here is the example:
User form module code:
' Add reference to Microsoft Scripting Runtime
' Assumed the userform with 2 listbox and button
Option Explicit
Public data As New Dictionary
Private Sub UserForm_Initialize()
Me.ListBox1.List = Array("item1", "item2", "item3")
Me.ListBox2.List = Array("item1", "item2", "item3")
End Sub
Private Sub CommandButton1_Click()
data("quit") = False
data("courtName") = Me.ListBox1.Value
data("courtType") = Me.ListBox2.Value
Unload Me
End Sub
Standard module code:
Option Explicit
Sub test()
Dim data As New Dictionary
data("quit") = True
Load UserForm1
Set UserForm1.data = data
UserForm1.Show
If data("quit") Then
MsgBox "Ввод данных отменен пользователем"
Exit Sub
End If
MsgBox data("courtName")
MsgBox data("courtType")
End Sub
Note the user form in that case can be closed (i. e. unloaded) right after all data is filled in and action button is clicked by user.
Another way is to check if the user form actually loaded:
Sub test()
UserForm1.Show
If Not isUserFormLoaded("UserForm1") Then
MsgBox "Ввод данных отменен пользователем"
Exit Sub
End If
End Sub
Function isUserFormLoaded(userFormName As String) As Boolean
Dim uf As Object
For Each uf In UserForms
If LCase(uf.Name) = LCase(userFormName) Then
isUserFormLoaded = True
Exit Function
End If
Next
End Function
In Excel-VBA, you can minimize the Excel Application once you opened the Workbook:
Private Sub Workbook_Open()
Application.WindowState = xlMinimized
End Sub
In Word-VBA, I tried this code, but it didn't work:
Private Sub Document_Open()
Application.WindowState = wdWindowStateMinimize
End Sub
It should be minimize the Word Application once you opened the Document.
Ok, after some testing I got it running, but it's a bit strange. It seems to be a timing problem.
This works:
Using DoEvents two times always works in my tests.
Only one DoEvents is not enough.
Info from Microsofts documentation about DoEvents:
Yields execution so that the operating system can process other events.
Private Sub Document_Open()
DoEvents: DoEvents
Application.WindowState = wdWindowStateMinimize
End Sub
That doesn't work either:
So I thought about adding a delay by using the API procedure Sleep and call this and DoEvents in a loop. But it didn't work.
Private Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As LongPtr)
Private Sub Document_Open()
Dim index As Integer
For index = 1 To 5
DoEvents
Sleep 50
Next index
Application.WindowState = wdWindowStateMinimize
End Sub
Contrary to the Excel documentation, the Word documentation of the Application.WindowState property says that the windows state can only be set with an active window:
The state of an inactive window cannot be set. Use the Activate method to activate a window prior to setting the window state.
So maybe you try to call Application.Activate first and see if that helps.
Contrary to the Excel documentation, the Word documentation of the
Application.WindowState property says that the windows state can only
be set with an active window:
Unhandled Exception gave a best description about the Application.WindowState.
Private Sub Document_Open()
ActiveWindow.WindowState = wdWindowStateMinimize
End Sub
Recently I've managed to find some code regarding a timer on a userform, my problem is that I need to keep the timer running even if the userform or excel file is closed... can someone take a look at the code and provide some feedback? My userform is: optionsForm
Dim dteStart As Date, dteFinish As Date
Dim dteStopped As Date, dteElapsed As Date
Dim boolStopPressed As Boolean, boolResetPressed As Boolean
Private Sub Reset_Timer_Click()
dteStopped = 0
dteStart = 0
dteElapsed = 0
Tech_Timer = "00:00:00"
boolResetPressed = True
End Sub
Private Sub Start_Timer_Click()
Start_Timer:
dteStart = Time
boolStopPressed = False
boolResetPressed = False
Timer_Loop:
DoEvents
dteFinish = Time
dteElapsed = dteFinish - dteStart + dteStopped
If Not boolStopPressed = True Then
Tech_Timer = dteElapsed
If boolResetPressed = True Then GoTo Start_Timer
GoTo Timer_Loop
Else
Exit Sub
End If
End Sub
Private Sub Stop_Timer_Click()
boolStopPressed = True
dteStopped = dteElapsed
End Sub
Private Sub optionsForm_Initialize()
Tech_Timer = "00:00:00"
End Sub
The idea of the timer is not that it runs, but that it remembers a point in time and can give you a difference between this point and the current moment. If you ask for this difference every second, then it would look like it is running like a watch.
Something like this would be a good start. In the xl_main write the following:
Option Explicit
Dim dtime As Date
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cells(1, 1).Value = dtime
End Sub
Private Sub Workbook_Open()
If Cells(1, 1).Value = 0 Then
dtime = Now
Else
dtime = CDate(Cells(1, 1))
End If
End Sub
You may play around it and make it better as you wish. E.g. you may find a way to reset dtime or anything similar.
"Something" needs to be running to handle the timer procedure so if you want to use VBA then Excel can't be "closed" per se, however you could make it appear closed.
An obvious option is to minimize the Excel window (before showing the userform) with the WindowState property:
Application.WindowState = xlMinimized
...or, hide the Excel window completely with the Visible property:
Application.Visible = False
...or if the issue is that you need a "fresh" copy of Excel to work in, you could do so in a new instance by holding Alt while starting Excel.
I have posted code and a downloadable example of a countdown timer that displays the time remaining on a userform semi-independent of the Excel window, using the Windows Timer API (instead of Excel's procedure), in another answer here.
That's not possible if the form is unloaded Unload optionsForm. But you can try to 'close' the form with optionsForm.hide() this only hides the form, the timer should keep running then.
The only way I see to calculate the time passed from a start time even if Excel is closed is to not save the start time in a variable dteStart but in an Excel cell.
Actually you can use a code that is placed in a module. The code is:
Option Explicit
Dim T
Sub stopTimer()
On Error Resume Next
Application.OnTime (T), Procedure:="Update", Schedule:=False
End Sub
Sub StartTimer()
T = Now + TimeValue("00:00:01")
Application.OnTime T, "Update"
End Sub
Sub Update()
UserForm1.TextBox1.Value = Format(Now - Sheets("Sheet1").Range("E11").Value,
"hh:mm:ss")
UserForm1.TextBox2.Value = Format(TimeValue("1:00:00") - (Now -
Sheets("Sheet1").Range("E11").Value), "hh:mm:ss")
Call StartTimer
End Sub
Thereafter, you can now reference it in the userform by calling it. Here is a typical example. It is
Private Sub Userform_Activate()
Sheet1.Activate
Sheets("Sheet1").Range("E11").Value = Now
Application.Run "StartTimer"
If Sheets("Sheet1").Range("K27").Value = "K29" Then
Me.CommandButton4.Caption = "Start"
Me.CommandButton2.Visible = False
End If
End Sub
I have an Excel workbook that has links to a webpage. The user can click on the links, which minimize the Excel window and open their browser. When they are done with the site, they minimize or close their browser, which returns them to Excel (as it was their previous active window).
I would like VBA to take an action (update a table) when the user is returned to Excel.
I've looked at the Workbook_WindowActivate event, but this only works if you are moving from one Excel Workbook to another within the Excel Application.
Maybe I could use Application.name or the Windows function GetActiveWindow somehow but I am not sure how best to do this.
Any ideas? Thanks!
You want to add an event handler for Workbook_SheetFollowHyperlink. You can then use the code below. This just checks to see if the webpage has focus. the ' DO EVENTS ' is where you would add your code and then exit the sub
'********************* References used
'* Microsoft Shell Controls An Automation : shell32.dll*
'* Microsoft HTML Objects Library: MSHTML.dll expand » *
'* Microsoft Internet Controls: IEFRAME.dll *
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim ie As InternetExplorer 'IE window variable
Dim sUrl 'url of the webpage
Dim dt As Date 'timer
'set the url to look for
sUrl = Target.Address
'set initial timeout period *used instead of browser ready due to page redirection.
'you should also check the browser ready status
dt = DateAdd("s", 5, DateTime.Now)
Do While dt > DateTime.Now
DoEvents
Loop
'reset the timeout period to allow time to view and select
dt = DateAdd("s", 30, DateTime.Now)
Dim shShell As New Shell ' windows shell variable
'continue loop until we hit the timeout or the webpage no longer has focus
Do While dt > DateTime.Now
'Loop through all the IE windows
For Each ie In shShell.Windows
'check to see if the URL's match
If InStr(ie.LocationURL, sUrl) Then
Dim hDoc As HTMLDocument
'get the webpage document
Set hDoc = ie.document
'check to see if it has focus
If Not hDoc.hasFocus Then
ThisWorkbook.Activate
'''''''''''''
' DO EVENTS '
'''''''''''''
Exit Sub
End If
Set hDoc = Nothing
End If
Next ie
Loop
End Sub
Here's what I've ended up doing. I borrowed quite a bit from this post: How to make a macro which executes periodically in Excel?
When the user clicks on a hyperlink, the code starts periodically checking whether Excel is their active window. I've found that the GetActiveWindow function returns zero if the user is not in the Excel application and some positive number if they are. If the code finds that the user returned to Excel from a different window (the previous check found that they were in a different window and the current one finds they are in Excel) then my table gets updated and the timer stops checking for the active window.
Doing it this way has the advantage of working for any web browser.
Option Explicit
Dim ExcelIsActive As Boolean
Private Declare Function GetActiveWindow Lib "user32" () As Long
Dim m_dtNextTime As Date
Dim m_dtInterval As Date
Dim DisableFlag As Boolean
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Call start
End Sub
Public Sub Enable(Interval As Date)
Call Disable
m_dtInterval = Interval
Call starttimer
End Sub
Private Sub starttimer()
m_dtNextTime = Now + m_dtInterval
Application.OnTime m_dtNextTime, "TestActive"
End Sub
Public Sub TestActive()
If GetActiveWindow > 0 Then
If ExcelIsActive = False Then
ExcelIsActive = True
Call RefreshQuery
End If
Else
ExcelIsActive = False
End If
If Not DisableFlag Then
Call starttimer
Else
Call Disable
End If
End Sub
Public Sub Disable()
Dim dtZero As Date
If m_dtNextTime <> dtZero Then
' Stop timer if it is running
On Error Resume Next
Application.OnTime m_dtNextTime, "TestActive", , False
On Error GoTo 0
m_dtNextTime = dtZero
End If
m_dtInterval = dtZero
End Sub
Sub start()
'Start the timer
DisableFlag = False
ExcelIsActive = True
'Sets the interval to be three seconds
Call Enable(#12:00:03 AM#)
End Sub
Public Sub RefreshQuery()
'I do my stuff here
'Stop the timer until the next time the user launches the browser
DisableFlag = True
End Sub
I have MS Access 2003 DB.
Is it possible for an event handler for a button on a form to fire twice??
I seem to have evidence of this happening as I have a payroll process
that logs the whole process and process is duplicated in the log.
I didnt think this was possible in VBA???
EDIT:
I discovered that indeed it was firing twice as user was clicking twice and queueing the event twice.
This is the fix I made to the code which shows using a flag m_locked as an example to test with:
[code]
Private m_locked As Boolean
Private m_count As Integer
Private Sub Command0_Click()
On Error GoTo Err_Command0_Click
' wait
If Not m_locked Then
m_locked = True
Dim startTime As Date
startTime = Now()
While DateDiff("s", startTime, Now()) < 3
DoEvents
Wend
' increment counter
m_count = m_count + 1
Command0.Caption = m_count
m_locked = False
End If
Exit_Command0_Click:
Exit Sub
Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click
End Sub
[/code]
Malcolm
Seeing your "solution" I'ld recommend to specify the double click event, too. This will allow you to distinguish easily whether the user clicked once or twice by a "debug.print".
To prevent the user to perform an extra click, declare a private boolean variable on form module level, set it to TRUE in your event procedure, set it to FALSE in the timer event, and configure your form's timer to 1000 for example (it's milliseconds).
Option Explicit
Option Compare Database
Private oneClick As Boolean
Private Sub cmdMyButton_Click()
If not oneClick Then
' Perform your actions here
End If
oneClick = True
End Sub
Private Sub Form_Timer()
oneClick = False
End Sub
Oh, and please use variable and control names that tell their meaning :-)
If you do not want your user click the button twice just this simple code:
Private Sub Command0_Click()
Command0.Enabled = False
' Continue with your code here ...
End Sub