asked on

Excel Macro to run while PC is locked

Hi,

I have a macro that runs when the file is opened. File is opened as a scheduled task.

There is a msgbox that pops up asking if the user wants the macro to run (so they can disable it for regular use of the file)

If the msgbox does not receive a response (or if the user clicks yes) the macro will continue.

This works fine while I am logged in, but if I lock (not logged out, just locked) the PC (alt-ctrl-del) the macro hangs at the msgbox until I unlock the PC. Once I unlock, the macro timer has already run out, so the macro autofires as it should.

I need this to work fully even if the PC is locked. Any suggestions?

Thank you.

Private Sub Workbook_Open()

Dim Answer As String

Answer = TmMsgBox("Should I continue?", vbYesNo + vbDefaultButton1, 6, "Macro check")

If Answer = vbNo Then Exit Sub

'if the user clicks yes the rest of the macro will run
'or if there is no imput, after x seconds, the macro will continue
'this fails if the PC is locked.

Here is the rest of the code for the msgbox

Option Explicit
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

'// ==========Public Declarations =================================
Public lTimerID As Long            '// Turn on and off with this ID
Public bTimerActive As Boolean     '// Is the Timer active
Public Const lTmMin As Long = &O2  '// Min time allowed
Public Const lTmDef As Long = &O5  '// Default if min set low
'// ===============================================================

Function TmMsgBox(sMsgPrompt As String, Btns As VbMsgBoxStyle, Optional ShowFor As Long, _
        Optional sTitle As String) As VbMsgBoxResult
        
    If sTitle = "" Then sTitle = Application.Name
    If ShowFor < lTmMin Then ShowFor = lTmDef
    ActivateMyTimer ShowFor
    AppActivate Application.Caption
    TmMsgBox = MsgBox(sMsgPrompt, Btns, sTitle)
    DeActivateMyTimer

End Function

Public Sub ActivateMyTimer(ByVal sec As Long)

sec = sec * 1000

If bTimerActive Then Call DeActivateMyTimer

On Error Resume Next
lTimerID = SetTimer(0, 0, sec, AddressOf Timer_CallBackFunction)
bTimerActive = True

End Sub

Public Sub DeActivateMyTimer()
    KillTimer 0, lTimerID
End Sub

Sub Timer_CallBackFunction(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, _
    ByVal SysTime As Long)
    
    Application.SendKeys "~", True

    If bTimerActive Then Call DeActivateMyTimer

End Sub

Open in new window

zorvek (Kevin Jones)

Is this on a terminal server?

Kevin

ASKER CERTIFIED SOLUTION

zorvek (Kevin Jones)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

TelMaco

ASKER

Yup that's perfect.

Here's what I did:

Private Sub Workbook_Open()

UserForm1.Show
'rest of code goes here if no click, or if click yes
...
End Sub

Added a userform for my msgbox:
Private Sub CommandButton1_Click()
Me.Hide
'Now the original macro will continue
End Sub

Private Sub CommandButton2_Click()
Me.Hide
'now all macros will exit
End
End Sub

Private Sub UserForm_Activate()
Dim TimeoutTime As Date
TimeoutTime = Now() + TimeSerial(0, 0, 5)
Do While Now() < TimeoutTime
DoEvents
Loop
Me.Hide
'now the original macro will continue
End Sub

Thanks!

TelMaco

ASKER

Flawless and so simple.

Other answers on the web were crazy complicated.

You make my life so easy!

Thanks again (=