vba - 确定计算机是否被锁定

Question

我有一个宏，当会议通知弹出时，它会从 Outlook 向我发送文本。我想找出一种方法，使该宏仅在我不在计算机旁时才运行。我一直在寻找一种方法来从 Skype for Business 中提取我的状态，确定 PC 是否被锁定，并查看是否插入了智能卡。都没有太多的运气。寻找适用于 VBA 的简单解决方案。

Answer 1

也许这有任何帮助

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

更新：示例如何使用上述功能

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

LockPC在解锁工作站之前，只需运行并等待 3 秒钟。该文件已在此期间关闭。

Answer 2

我使用了此处的代码确定应用程序是否正在使用 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

根据此处的答案在 Python 3 中，如何判断 Windows 是否已锁定？

我打了电话

IsProcessRunning("LogonUI.exe")

它似乎工作。