VBA – Computer Uptime

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.

One response on “VBA – Computer Uptime

  1. Dave Talbot

    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?