Automatischer "Logout"

Forumthread: Automatischer "Logout"

20.11.2014 09:32:41

Marcus

Hallo,
ich habe mir das folgende Makro zusammen gebastelt, dass dafür sorgen soll, dass nach einer definierten Zeit ab dem letzten Klicken oder Tippen etwas passiert.


Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare PtrSafe Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
'Logout nach X Minuten
Function IdleTime() As Single
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTime = (GetTickCount - a.dwTime) / 1000
End Function
Sub Idle_Timer()
Application.OnTime Now + TimeSerial(0, 1, 0), "Logout"
End Sub
Sub Idle_Timer2()
Application.OnTime Now + TimeSerial(0, 1, 0), "Logout"
End Sub
Sub Logout()
ActiveWorkbook.Unprotect Passwort_Admin
Worksheets("Datenbasis").Visible = xlVeryHidden
Worksheets("Normalschicht").Visible = xlVeryHidden
Worksheets("Schicht1").Visible = xlVeryHidden
Worksheets("Schicht2").Visible = xlVeryHidden
Worksheets("Schicht3").Visible = xlVeryHidden
Worksheets("Abteilungsleiter").Visible = xlVeryHidden
Worksheets("Anleitung").Visible = xlVeryHidden
Sheets("Startseite").Range("A1").Select
Application.CommandBars("Ply").Enabled = False
ActiveWorkbook.Protect Passwort_Admin, Structure:=True
Call Idle_Timer2
End Sub
Sub Logout2()
ActiveWorkbook.Unprotect Passwort_Admin
Worksheets("Datenbasis").Visible = xlVeryHidden
Worksheets("Normalschicht").Visible = xlVeryHidden
Worksheets("Schicht1").Visible = xlVeryHidden
Worksheets("Schicht2").Visible = xlVeryHidden
Worksheets("Schicht3").Visible = xlVeryHidden
Worksheets("Abteilungsleiter").Visible = xlVeryHidden
Worksheets("Anleitung").Visible = xlVeryHidden
Sheets("Startseite").Range("A1").Select
Application.CommandBars("Ply").Enabled = False
ActiveWorkbook.Protect Passwort_Admin, Structure:=True
Call Idle_Timer
End Sub

Das Ganze funktioniert soweit auch ganz gut, jedoch wird die 1 Minute nicht richtig eingehalten.
Die Ausführung passiert jeweils bereits nach ~44 Sekunden.
Kann mir das jemand erklären?
Danke im Voraus
Marcus

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Automatischer "Logout"

20.11.2014 11:22:01

Marcus

AW: Automatischer "Logout"

20.11.2014 11:22:01

Marcus

Hallo nochmal,
ich hatte einen Denkfehler.
Hier die Lösung für alle mit einem ähnlichen Vorhaben:


'In "Diese Arbeitsmappe"
Private Sub Workbook_Open()
Call Idle_Timer
End Sub


'Deklarationsteil eines Modules
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare PtrSafe(Kann bei Win32 entfallen) Sub GetLastInputInfo Lib "user32" ( _
ByRef plii As LASTINPUTINFO)
Private Declare PtrSafe(Kann bei Win32 entfallen) Function GetTickCount Lib "kernel32" () _
As Long
'Logout nach 15 Minuten
Function IdleTime() As Single
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTime = (GetTickCount - a.dwTime) / 1000 'Idletime in Sekunden
End Function
Sub Idle_Timer()
If IdleTime >= 900 Then 'Vergleich Idletime mit Zeitvorgabe in Sekunden
'Was soll passieren
End If
Application.OnTime Now + TimeValue("0:0:1"), "Idle_Timer2" 'Wiederholungsprüfung nach 1 Sekunde
End Sub
Sub Idle_Timer2()
If IdleTime >= 900 Then 'Vergleich Idletime mit Zeitvorgabe in Sekunden
'Was soll passieren
End If
Application.OnTime Now + TimeValue("0:0:1"), "Idle_Timer" 'Wiederholungsprüfung nach 1 Sekunde
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Automatischer "Logout"

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread