MS Word中的VB宏

Question

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.

Answer 1

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