Determine if the computer is locked - vba

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.

Answer 1

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.

Answer 2

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.