I’ve been dealing with an ongoing issue with Access 2010 where calculated controls do not display values.
When you start Microsoft Access 2010 on a computer that has not been restarted for a long time (for example, 24 days).
…
fields that are bound to expressions on forms may not be recalculated when the computer has not been restarted for a long time.
Taken from: https://support.microsoft.com/en-us/kb/2965300
Using WMI
Now, in this particular case, I have little access to the IT department to be in a position to determine how long the servers been running for (without a reboot), nor which updates have been installed. So I set out to write a function to determine the server’s uptime and I knew WMI was the ticket. Below is the function that I developed.
'---------------------------------------------------------------------------------------
' Procedure : GetPCUptime
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Determine how long a computer has been running since its last boot
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHost : Name, IP address of the computer to check
' Omit this input variable if checking the local PC
'
' Usage:
' ~~~~~~
' ? GetPCUptime
' sUptime = GetPCUptime("172.12.243.195")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-07-19 Initial Release
'---------------------------------------------------------------------------------------
Function GetPCUptime(Optional sHost As String = ".") As String
'Ref: https://msdn.microsoft.com/en-us/library/aa394272(v=vs.85).aspx
On Error GoTo Error_Handler
Dim oWMI As Object 'WMI object to query about the PC's OS
Dim oOSs As Object 'Collection of OSs
Dim oOS As Object 'Individual OS
Dim lUpTime As Long
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
Set oOSs = oWMI.ExecQuery("SELECT SystemUpTime FROM Win32_PerfFormattedData_PerfOS_System")
For Each oOS In oOSs
lUpTime = oOS.SystemUpTime
Select Case lUpTime
Case Is < 3600
GetPCUptime = Int(oOS.SystemUpTime / 60) & " minutes"
Case Is < 86400
GetPCUptime = Int(oOS.SystemUpTime / 3600) & " hours"
Case Else
GetPCUptime = Int(oOS.SystemUpTime / 86400) & " days"
End Select
Next
Error_Handler_Exit:
On Error Resume Next
Set oOS = Nothing
Set oOSs = Nothing
Set oWMI = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetPCUptime" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Do note that the function takes a couple seconds to return a value. Furthermore, for my needs I used the Int() to round the values. If you need a very precise uptime calculation then you may wish to remove the Int().
Using APIs
As part of a recent discussion on UA Gustav showed an API (timeGetTime) that can retrieve the number of milliseconds since the computer’s last boot. Armed with this, I created the following function:
'https://docs.microsoft.com/en-us/previous-versions/ms713418(v=vs.85)
#If VBA7 Then
Public Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long 'milliseconds
#Else
Public Declare Function timeGetTime Lib "winmm.dll" () As Long 'milliseconds
#End If
'---------------------------------------------------------------------------------------
' Procedure : GetUpTime
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return a string representing how long the PC has been running without a
' reboot.
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
' References: Requires a copy timeGetTime API Declaration
'
' Usage:
' ~~~~~~
' ? GetUpTime
' Returns -> 10 days 20:49:09.557
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2022-07-30 Initial Release
'---------------------------------------------------------------------------------------
Public Function GetUpTime()
Dim lUptime As Long
Dim lDays As Long
Dim lHours As Long
Dim lMinutes As Long
Dim lSeconds As Long
lUptime = timeGetTime()
lSeconds = lUptime / 1000 ' Convert into seconds
lDays = Int(lSeconds / 86400#)
lSeconds = lSeconds - (lDays * 86400)
lHours = Int(lSeconds / 3600#)
lSeconds = lSeconds - (lHours * 3600)
lMinutes = Int(lSeconds / 60#)
lSeconds = lSeconds - (lMinutes * 60)
If lDays > 0 Then
GetUpTime = lDays & " days "
End If
GetUpTime = GetUpTime & lHours & ":" & Format(lMinutes, "00") & ":" & Format(lSeconds, "00") & "." & Right(lUptime, 3)
End Function
Do note this has only been tested in a very limited capacity.
I had originally hopped to use TimeSerial to convert the seconds into a usable date/time variable, but it is limited by the capacity of the seconds input argument which is of Integer data type, so only 32767 (9:06:07.316 – not even a day!), which simply is too small for use within this function.
Hi
I sent this to you as a message on your we site then thought I should have put it here so that others get the bentfit of a reply.
I am trying to use the function in my MS Access O365 version 32 bit (13127.21668) and the function fails with an automation error on the line ‘For Each oOS In oOSs’
What am I missing please?