Show Login Form If Workbook In Active

[Pacman52]

I have a workbook that shows a login form when opened and nothing else. Once the user puts in the credentials and logs in the workbook opens and they have access to whatever they are allowed to use - All of this works perfectly for what I need although whilst doing some final testing I did realise that if a user leaves their desk then the workbook is open to anyone who jumps onto the computer.

Is there a way through VBA to have the log on form appear again after a set amount of time (say 5 minutes) if there has been no activity just on the workbook itself.

Its not critical to me to implement this but it would be just another layer of 'security' and I'd be interested to know if it can be done?

Thanks

Paul

 

[Jeffrey Mahoney]

Yes. There are some nuances when it comes to setting up OnTime timers. This works very well. You can edit the times by editing these lines
ActEndTime = Now() + TimeValue("00:00:20")
and
If LastChange > 0 And (Now() - LastChange) * 86400 >= 1200 Then

ask any questions

This code goes into the THISWORKBOOK module

Private Sub Workbook_Open()
  Application.DisplayAlerts = False
  Startup = True
  
  LastChange = Now()
  ActEndTime = Now() + TimeValue("00:00:20")
  Application.OnTime ActEndTime, "CheckActivity", schedule:=True

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Startup = True Then
    Startup = False
    Application.DisplayAlerts = True
  End If
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  LastChange = Now()
  Debug.Print LastChange
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  On Error Resume Next
  Application.OnTime ActEndTime, "CheckActivity", schedule:=False
  Application.OnTime FinalEndTime, "FinalClose", schedule:=False
  On Error GoTo 0
End Sub

This code needs to go into a Standard module

Public Startup As Boolean
Public LastChange As Date
Public ActEndTime As Date
Public FinalEndTime As Date

Sub CheckActivity()
  
  On Error Resume Next
  Application.OnTime ActEndTime, "CheckActivity", schedule:=False
  On Error GoTo 0
  
  If LastChange > 0 And (Now() - LastChange) * 86400 >= 1200 Then      '8 Minutes = 480, 20 minutes = 1200; (60 seconds X 2 = 120 = 2 minutes)
    FinalEndTime = Now() + TimeValue("00:00:10")
    Application.OnTime FinalEndTime, "FinalClose", schedule:=True
    Exit Sub
  End If
  
  'Debug.Print Format(8 - (Now() - LastChange) * 86400 / 60, "#.0")
  
  ActEndTime = Now() + TimeValue("00:00:20")
  Application.OnTime ActEndTime, "CheckActivity", schedule:=True
  
End Sub


Sub FinalClose()
  
  DoEvents
  ThisWorkbook.Close savechanges:=True
  
End Sub

 

[Jeffrey Mahoney]

I gave you code to close the workbook. You could add the code the FinalClose that will hide all the sheets except the Login sheet.

 

[Pacman52]

Hi Jeffrey, firstly many thanks for such a detailed response although I'm a tad confused with the two subs you've mentioned so for clarity the Workbook is coded on open to hide / disable all the main elements of a workbook like the ribbon, sheet tabs ect and these all remain 'hidden' all of the time when the workbook is open and being used (Basically all a user see's is the relevant worksheet with just the Excel logo and file name at the top of the window).

Once the workbook is initially opened then the user sees a userform (login) and nothing else and once the correct password has been entered the main menu worksheet becomes visible and the user can the proceed to use the workbook.

The workbook itself only contains 4 worksheets with 1 of these being a 'background' worksheet (named 'BG') that is simply there to show behind any of the other userform's just for aesthetics'.

ActEndTime = Now() + TimeValue("00:00:20")
and
If LastChange > 0 And (Now() - LastChange) * 86400 >= 1200 Then

So if I adapted the code shown in your first reply after 'Then' to show the login form and the BG worksheet would that work?

I really don't need the Workbook to close completely at this point I just need to restrict access to any of the worksheets or userforms until the user has logged in again.

Hopefully thanks makes sense

Paul