I asked a similar question a few months ago:
It says it's a compile error and I need to update the code with PtrSafe method. And my code to fix it did not work. The user says it's the same error, but I can't confirm it since I don't have a x64 computer.
Where did I go wrong in the declaration of the sub?
The code works on x86 computers.
This failed too:
#If VBA7 Then
'Office 2013 & above
#If Win64 Then
'x64 host
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr
Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
Private Type LASTINPUTINFO
cbSize As LongPtr
dwTime As LongPtr
End Type
#Else
'x86 host
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
#End If
#Else
'Office 2010 & under:
Private Declare Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
#End If
Complete module code as it is now:
'Private Type LASTINPUTINFO
' cbSize As Long
' dwTime As Long
'End Type
#If VBA7 Then
'Office 2013 & above
#If Win64 Then
'x64 host
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr
Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
Private Type LASTINPUTINFO
cbSize As LongPtr
dwTime As LongPtr
End Type
#Else
'x86 host
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
#End If
#Else
'Office 2010 & under:
Private Declare Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
#End If
'
'Private Declare Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
'Private Declare Function GetTickCount Lib "kernel32" () As Long
Function IdleTime() As Single
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTime = (GetTickCount - a.dwTime) / 1000
End Function
Sub Form_Timer()
LR = ThisWorkbook.Sheets("Inaktivitet").Cells(Sheets("Inaktivitet").Rows.Count, "B").End(xlUp).Row
If Not IsError(Application.Match(UCase(Environ("UserName")), ThisWorkbook.Sheets("Inaktivitet").Range("B21:B" & LR), 0)) Then
Exit Sub
End If
tme = IdleTime
Debug.Print tme & " " & Now()
If tme >= ThisWorkbook.Sheets("Inaktivitet").Range("E14").Value * 60 Then
ThisWorkbook.Save
Application.EnableEvents = False
ThisWorkbook.Close
Application.EnableEvents = True
End If
Application.OnTime Now TimeSerial(0, 0, 5), "Form_Timer"
End Sub
So it runs the form_timer every five seconds and if above a threshold it will save and close the workbook
CodePudding user response:
All you should need is:
#If VBA7 Then
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
#End If