Determine if the computer is locked

Question

I have a macro that send me a text from outlook when a meeting notification pops up. I would like to figure out a way to make that macro only run if I am not at my computer. I have looked for a way to pull my status from Skype for Business, determine if the PC is locked or not, and see if a smart card is inserted. All without much luck. Looking for a simple solution that works in VBA.

[GetLastInputIdle](http://vbnet.mvps.org/index.html?code/system/getlastinputinfo.htm) tells you the time since the last keyboard/mouse action & would work if you go AFK without locking. — Alex K., Mar 06 '20 at 15:20

Storax · Answer 1 · 2020-03-06T14:41:41.433

Maybe this is of any help

Option Explicit

Private Declare Function SwitchDesktop Lib "User32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "User32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "User32" (ByVal hDesktop As Long) As Long

Private Const DESKTOP_SWITCHDESKTOP As Long = &H100    

Function desktopLocked() As String
Dim p_lngHwnd As Long
Dim p_lngRtn As Long
Dim p_lngErr As Long
Dim System As String

    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)

    If p_lngHwnd = 0 Then
        System = "Error"
    Else
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
        p_lngErr = Err.LastDllError

        If p_lngRtn = 0 Then
            If p_lngErr = 0 Then
                System = "Locked"
            Else
                System = "Error"
            End If
        Else
            System = "Unlocked"
        End If

        p_lngHwnd = CloseDesktop(p_lngHwnd)
    End If
    desktopLocked = System
End Function

Update: Example how one could use the function above

Option Explicit
#If VBA7 Then
Declare PtrSafe Function LockWorkStation Lib "user32.dll" () As Long
#Else
Declare Function LockWorkStation Lib "user32.dll" () As Long
#End If

Dim iTimerSet As Double

Public Sub SaveAndClose()
    If desktopLocked = "Locked" Then
        ThisWorkbook.Close True
    Else
        iTimerSet = Now + TimeValue("00:00:03")
        Application.OnTime iTimerSet, "SaveAndClose"
    End If

End Sub

Sub LockPC()
    SaveAndClose
    LockWorkStation
End Sub

Just run LockPC and wait 3 seconds before you unlock the workstation. The file has been closed in the meantime.

I am not sure how to debug that besides creating a meeting and locking my pc and waiting for the notification. When I do that it always returns unlocked on Windows 10. — DaGentooBoy, Mar 06 '20 at 14:27
This function retruns "Locked" when the system is locked. What do you mean with _how to debug_? You just need a `if` condition to check if the system is locked and if it is you run your macro. By your post you already have a macro running, right? — Storax, Mar 06 '20 at 14:36
I updated the post and added an example how to use the function. — Storax, Mar 06 '20 at 14:42
I just meant that it's a slow debugging process because I have to create a meeting with a reminder in 1 min and then lock my PC and see if it send me a message. For some reason the code above always returned unlocked even if the computer was locked. — DaGentooBoy, Mar 07 '20 at 23:17

score 0 · Accepted Answer · answered Mar 06 '20 at 14:32

I used the code from here Determine if application is running with Excel

Function IsProcessRunning(process As String)
    Dim objList As Object

    Set objList = GetObject("winmgmts:") _
        .ExecQuery("select * from win32_process where name='" & process & "'")

    If objList.Count > 0 Then
        IsProcessRunning = True
    Else
        IsProcessRunning = False
    End If

End Function

Based on the answer here In Python 3, how can I tell if Windows is locked?

I called

IsProcessRunning("LogonUI.exe")

and it seems to work.

Determine if the computer is locked

2 Answers2