keep macro running

[pawanhsharma]

Hello Everyone, does anybody have a solution for me, I have below code which record Idle time. it work fine only if I am working in this file only. if I move to oter file or application it stops recording the time.

Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub IdleTime()
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTicks = 5

Counter_Flag = ThisWorkbook.Sheets(1).Cells(1, 5)
If Counter_Flag = "" Then Counter_Flag = 1
idleT = ((GetTickCount - a.dwTime) / 1000)
If idleT > IdleTicks Then
If Counter_Flag = 1 Then
ThisWorkbook.Sheets(1).Cells(1, 4) = ThisWorkbook.Sheets(1).Cells(1, 4) + 1
RowIdx = ThisWorkbook.Sheets(1).Cells(1, 4)
ThisWorkbook.Sheets(1).Cells(RowIdx, 3) = "Idle"
ThisWorkbook.Sheets(1).Cells(1, 5) = 0
ThisWorkbook.Sheets(1).Cells(RowIdx, 2).NumberFormat = "m/d/yyyy h:mm:ss"
ThisWorkbook.Sheets(1).Cells(RowIdx, 2) = VBA.Now
ThisWorkbook.Sheets(1).Cells(RowIdx, 1) = idleT
End If
End If

If idleT < IdleTicks Then
If Counter_Flag = 0 Then
ThisWorkbook.Sheets(1).Cells(1, 4) = ThisWorkbook.Sheets(1).Cells(1, 4) + 1
RowIdx = ThisWorkbook.Sheets(1).Cells(1, 4)
ThisWorkbook.Sheets(1).Cells(RowIdx, 3) = "Active"
ThisWorkbook.Sheets(1).Cells(1, 5) = 1
ThisWorkbook.Sheets(1).Cells(RowIdx, 2).NumberFormat = "m/d/yyyy h:mm:ss"
ThisWorkbook.Sheets(1).Cells(RowIdx, 2) = VBA.Now
ThisWorkbook.Sheets(1).Cells(RowIdx, 1) = idleT
End If
End If

Application.OnTime Now + TimeValue("00:00:05"), "IdleTime"
End Sub