VBA – Determine the BIOS Serial Number

As part of the same discussion as with my previous post VBA – Get Processor Id the user also wanted to determine the PC’s BIOS Serial Number. Using the same technique, but switching over to using the Win32_BIOS class we can once again easily gather this information.

Below is a function that retrieves the BIOS Serial Number using WMI.

'---------------------------------------------------------------------------------------
' Procedure : GetBIOSSerialNumber
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Retrieve the BIOS Serial Number
' 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: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHost     : Name/IP Address of the PC to query assuming you have the rights to do so
'               optional, so by leaving it blank it will query the local computer
'
' Usage:
' ~~~~~~
' ? GetBIOSSerialNumber
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-09-03              Initial Release
'---------------------------------------------------------------------------------------
Function GetBIOSSerialNumber(Optional sHost As String = ".") As String
    'Win32_BIOS -> https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-bios
    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query
    Dim oBIOSs                As Object
    Dim oBIOS                 As Object

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    Set oBIOSs = oWMI.ExecQuery("SELECT SerialNumber FROM Win32_BIOS")

    For Each oBIOS In oBIOSs
        GetBIOSSerialNumber = GetBIOSSerialNumber & oBIOS.SerialNumber & ","
    Next
    If Right(GetBIOSSerialNumber, 1) = "," Then GetBIOSSerialNumber = Left(GetBIOSSerialNumber, Len(GetBIOSSerialNumber) - 1)

Error_Handler_Exit:
    On Error Resume Next
    If Not oBIOS Is Nothing Then Set oBIOS = Nothing
    If Not oBIOSs Is Nothing Then Set oBIOSs = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetBIOSSerialNumber" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Similarily, you can change the function to iterate over all the properties rather than just the BIOS Serial Number. Below is an example of how you can achieve this

'---------------------------------------------------------------------------------------
' Procedure : GetBIOSProperties
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : List all the available WMI BIOS properties
' 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: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHost     : Name/IP Address of the PC to query assuming you have the rights to do so
'               optional, so by leaving it blank it will query the local computer
'
' Usage:
' ~~~~~~
' ? GetBIOSProperties
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-09-03              Initial Release
'---------------------------------------------------------------------------------------
Function GetBIOSProperties(Optional sHost As String = ".") As String
'Win32_BIOS -> https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-bios
'    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query
    Dim oBIOSs                As Object
    Dim oBIOS                 As Object
    Dim oPrp                  As Object

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    Set oBIOSs = oWMI.ExecQuery("SELECT SerialNumber FROM Win32_BIOS")

    For Each oBIOS In oBIOSs
        For Each oPrp In oBIOS.Properties_
            Debug.Print oPrp.Name, oPrp.Value
        Next oPrp
    Next

Error_Handler_Exit:
    On Error Resume Next
    If Not oPrp Is Nothing Then Set oPrp = Nothing
    If Not oBIOS Is Nothing Then Set oBIOS = Nothing
    If Not oBIOSs Is Nothing Then Set oBIOSs = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetBIOSProperties" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

These functions are not restricted to Access and will work in any VBA compatible application (Access, Excel, Word, …).

8 responses on “VBA – Determine the BIOS Serial Number”

    1. Daniel Pineault Post author

      Sure, you’d simply adapt the code to something like

      Function GetHDSN(Optional sHost As String = ".") As String
'Win32_BIOS -> https://docs.microsoft.com/en-us/windows/win32/cimwin32prov/win32-diskdrive
    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query
    Dim oDiskDrives           As Object
    Dim oDiskDrive            As Object

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    Set oDiskDrives = oWMI.ExecQuery("SELECT SerialNumber FROM Win32_DiskDrive")
    
    On Error Resume Next
    For Each oDiskDrive In oDiskDrives
        GetHDSN = GetHDSN & Trim(oDiskDrive.SerialNumber) & ","
    Next
    If Right(GetHDSN, 1) = "," Then GetHDSN = Left(GetHDSN, Len(GetHDSN) - 1)

Error_Handler_Exit:
    On Error Resume Next
    If Not oDiskDrive Is Nothing Then Set oDiskDrive = Nothing
    If Not oDiskDrives Is Nothing Then Set oDiskDrives = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetHDSN" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function
      1. tom

        hi, thanks Daniel.
        in your code i was getting error and fixed by adding “\” at 2 locations.
        kindly edit your post.
        Set oWMI = GetObject(“winmgmts:{impersonationLevel=impersonate}!” & sHost & “rootcimv2”)
        Set oWMI = GetObject(“winmgmts:{impersonationLevel=impersonate}!\\” & sHost & “\root\cimv2”)

        Secondly, is it possible to get serial of specific hard disk if more than one is attached.
        Regards.

        1. Daniel Pineault Post author

          Yes, indeed. Thank you for pointing it out. They are there in my comment, but for some reason not rendering. Let me see what I can do to correct the situation.

          It should be fixed now. It’s apparently a known WordPress issue.

  2. tom

    hi, Daniel
    the code gives serial info for all drives attached. Is it possible to get serial for specific drive e.g primary drive only.
    Regards.

      1. Daniel Pineault Post author

        Here, you could try the following (I haven’t had time to fully test it though)

        Function GetHDSN4PrimaryHD(Optional sHost As String = ".") As String
    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query
    Dim oPartitions           As Object
    Dim oPartition            As Object
    Dim oDiskDrives           As Object
    Dim oDiskDrive            As Object
    Dim sDeviceID             As String


    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    Set oPartitions = oWMI.ExecQuery("SELECT BootPartition, DeviceID FROM Win32_DiskPartition")

    On Error Resume Next
    For Each oPartition In oPartitions
        If oPartition.BootPartition Then    'PrimaryPartition
            Set oDiskDrives = oWMI.ExecQuery _
                              ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & _
                               oPartition.DeviceID & "'} WHERE AssocClass = " & _
                               "Win32_DiskDriveToDiskPartition")
            On Error Resume Next
            For Each oDiskDrive In oDiskDrives    'Shouldn't really be a loop
                GetHDSN4PrimaryHD = GetHDSN4PrimaryHD & Trim(oDiskDrive.SerialNumber) & ","
            Next
            If Right(GetHDSN4PrimaryHD, 1) = "," Then GetHDSN4PrimaryHD = Left(GetHDSN4PrimaryHD, Len(GetHDSN4PrimaryHD) - 1)
            Exit For
        End If
    Next

Error_Handler_Exit:
    On Error Resume Next
    If Not oPartition Is Nothing Then Set oPartition = Nothing
    If Not oPartitions Is Nothing Then Set oPartitions = Nothing
    If Not oDiskDrive Is Nothing Then Set oDiskDrive = Nothing
    If Not oDiskDrives Is Nothing Then Set oDiskDrives = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetHDSN4PrimaryHD" & 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