VBA code for motherboard serial number

[hrayani]

Hello Friends,

I am using the below code to return motherboard serial number & it works fine except on one machine where it returns only a comma ","

Can someone pls check why is this happening as the code is running perfectly fine on other machines

Public Function MBSerialNumber() As String
Dim objs As Object
Dim obj As Object
Dim WMI As Object
Dim sAns As String
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("Win32_BaseBoard")
For Each obj In objs
    sAns = sAns & obj.SerialNumber
    If sAns < objs.Count Then sAns = sAns & ","
Next
MBSerialNumber = sAns

End Function

 

[Kaper]

This is a strange part in your code which leads to comma-only result:

If sAns < objs.Count

you compare a string (in case of this computer it is something like KB45NB... - real serial "number" containing letters and digits) with real nymber - just count (in case of my computer it is 1 because objs collection has only one element.

When obj.SerialNumber returns empty string, you have "" < 1 or as a matter of fact "" < "1", because Excel would do a type cast here, and that is true so comma is concatenated with empty string.

So if you expect more elements in this collection, each containing serial number, the right part of the code could be:

For Each obj In objs
    sAns = sAns & "," & obj.SerialNumber
Next
MBSerialNumber = Mid(sAns, 2)

But it is probably just a side comment. You are facing empy serialnumber, and you probably need to somehow identify the computer. Using the same toolset it could be done that way (note that the property is defined by user so it is not that secure as real serialnumber):

Public Function MBSerialNumber() As String
Dim objs As Object
Dim obj As Object
Dim WMI As Object
Dim sAns As String
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("Win32_BaseBoard")
For Each obj In objs
    sAns = sAns & "," & obj.SerialNumber & "," & obj.Description
Next
MBSerialNumber = Mid(sAns, 2)
If MBSerialNumber = "" Then
Set objs = WMI.InstancesOf("Win32_MotherboardDevice")
For Each obj In objs
    sAns = sAns & "," & obj.SystemName
Next
MBSerialNumber = Mid(sAns, 2)
End Function

 

[hrayani]

Dear Kaper,

Thanks for putting in your time into this

I tried the code but it does not work - this time it returns → ",Base Board"

Also, I did not understand "(note that the property is defined by user so it is not that secure as real serialnumber)"

Regards,

Humayun

 

[Kaper]

So indeed WMI.InstancesOf("Win32_BaseBoard") returns the object with obj.SerialNumber being empty.
I forgot I've added obj.Description (in your case it was "BaseBoard") so function never tests WMI.InstancesOf("Win32_MotherboardDevice")
Try this one:

Public Function MBSerialNumber() As String
Dim objs As Object
Dim obj As Object
Dim WMI As Object
Dim sAns As String
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("Win32_BaseBoard")
For Each obj In objs
    sAns = sAns & "," & obj.SerialNumber
Next
MBSerialNumber = Mid(sAns, 2)
If MBSerialNumber = "" Then
Set objs = WMI.InstancesOf("Win32_MotherboardDevice")
For Each obj In objs
    sAns = sAns & "," & obj.SystemName
Next
MBSerialNumber = Mid(sAns, 2)
End Function

in case SerialNumber is empty it shall return (hopefully this will not be empty, but who knows ) a SystemName from WMI.InstancesOf("Win32_MotherboardDevice").
This SystemName shall be the sane as you could get with easier approach - just by:

msgbox Environ("USERDOMAIN")

 

[hrayani]

Thanks again
But it returns an empty cell on one particular machine
On all other machines it works just fine

I checked the cell with len function & the answer was 1 - which shows that there is a space in the cell

My goal is to call the motherboard serial number at the workbook open event & place it in cell A1 & then check if the number is in the allow list then continue else close the workbook. I was working on this successfully until two days back where I had to allow another machine to run the file & that's the machine which does not return the motherboard serial number

I opted for this approach because 2 different machines can't have same motherboard serial number (at least what I know - pls correct me if I am wrong here)

Can you suggest some other ideas coz the motherboard serial number is not working - any other similar idea but that number or series should be unique means no two machines can & should have the same number

Regards,

Humayun

 

[Kaper]

Is this: Environ("USERDOMAIN") also empty? I know that in general it's not unique, but for computers connected to the same network shall be unique.

and second idea: how abour drive serialnumber

Function GetDriveSN() As String
Dim fs, d
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(ActiveWorkbook.Path)))
GetDriveSN = d.SerialNumber
Set d = Nothing
Set fs = Nothing
End Function

Hope that code is not called from a network or USB drive. If it is, try the following mod always looking on C: drive:

Function GetCDriveSN() As String
Dim d
With CreateObject("Scripting.FileSystemObject")
  Set d = .GetDrive(.GetDriveName(.GetAbsolutePathName("C:")))
  GetCDriveSN = d.SerialNumber
  Set d = Nothing
End With
End Function

 

[hrayani]

Hi Kaper,

the Environ("USERDOMAIN") does not return empty - but it can be similar on 2 different machines

regarding the drive serialnumber : pls let me know that is there any possibility for two different machines to have the same drive serialnumber
if no, then I can try it
if yes, then it does not serve the purpose

Regards,

Humayun

 

[jimrward]

take a look at a post i was involved in years ago, might give you some pointers, its a mixture of vbscript and vba

VBA to Collect Computer Attritbutes

Greetings All, I have a school the runs 30+ computers. Recently, we had a lot of them stolen. I would like to have my inventory not only list the SN of each, but also a lot of the fine details that help recover these items if it occurs again. I am a start-up school, money is very tight, so...

www.mrexcel.com

 

[Georgiboy]

How about combining the BIOS serial number with the computer name, that should give you a unique string per machine:

Private Sub Workbook_Open()
  Sheet1.Range("A1") = GetUniqueComputerID
End Sub

Function GetUniqueComputerID() As String
    Dim objWMIService As Object
    Dim colItems As Object
    Dim objItem As Object
    Dim strBIOSSerialNumber As String
    Dim strComputerName As String
    
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS")
    For Each objItem In colItems
        strBIOSSerialNumber = objItem.SerialNumber
        Exit For
    Next objItem
    Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    For Each objItem In colItems
        strComputerName = objItem.Name
        Exit For
    Next objItem

    GetUniqueComputerID = strBIOSSerialNumber & "-" & strComputerName
End Function

 

[hrayani]

Hi Georgiboy,

That's a good idea - I was just thinking of combining two different things

by the way do you know if BIOS serial number can be same on two different machines ??

Regards,

Humayun