Home > Mobile >  PtrSafe sub declaration?
PtrSafe sub declaration?

Time:09-30

I asked a similar question a few months ago:
enter image description here

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
  • Related