Results 1 to 3 of 3
  1. #1
    Join Date
    Sep 2013

    Unanswered: VBA to Capture Windows lock and Un-lock timings in Access 2010

    Dear All,

    I am working on the Productivity management tool.
    where the user will login and update his/her daily activity.

    here i am thinking of logic where system will automatically mark employee on break if the system is locked.

    As per the company IT policies system will automatically lock itself, If system is idle more that 5min.

    Application should capture this system lock and unlock timing.

    Kindly assist me in this regard.

    Thanks in Advance.
    Prasanna RD

  2. #2
    Join Date
    Apr 2014
    Provided Answers: 34
    Here's the thing, you need a form that is always open AND has a timer. You can set the timer interval to 1000, (1 second).
    Every second, the form will check to see if the screen went into Lock, then when it does , it will run a query to post a record to a table, recording the user and the time it went into lock. (qaPostOnBreak query).
    Same with the 'come out of lock mode', it runs a query.(these queries are up to you to design)

    You can open the timer form and make it invisible so it wont bother the user.
    Post this code into the timer form vb.

    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
    Private mbOnBreak
    Function Check_If_Locked() As String
        Dim p_lngHwnd As Long
        Dim p_lngRtn As Long
        Dim p_lngErr As Long
        Dim system
        p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
        If p_lngHwnd = 0 Then
            system = "Error"
            p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
            p_lngErr = Err.LastDllError
            If p_lngRtn = 0 Then
                If p_lngErr = 0 Then
                    system = "Locked"
                    If Not mbOnBreak Then
                        DoCmd.SetWarnings False
                          DoCmd.OpenQuery "qaPostOnBreak"
                          mbOnBreak = True
                        DoCmd.SetWarnings True
                    End If
                    system = "Error"
                End If
                system = "Unlocked"
                If mbOnBreak Then
                      DoCmd.SetWarnings False
                          DoCmd.OpenQuery "qaPostBackFromBreak"
                          mbOnBreak = False
                      DoCmd.SetWarnings True
                End If
            End If
            p_lngHwnd = CloseDesktop(p_lngHwnd)
        End If
        Check_If_Locked = system
    End Function
    'the timer runs the Check every second:

    Private Sub Form_Timer()
    Debug.Print Check_If_Locked, Now()
    End Sub

  3. #3
    Join Date
    Sep 2013
    Thank you Ranman...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts