HDD Serial

amir0914

Registered User.
Local time
Yesterday, 20:05
Joined
May 21, 2018
Messages
151
Hi all,
I need to extract hard disk serial number by vba, but I don't mean serial of drive "c", because this serial changes with the windows change, I mean the serial of hard disk.
Can someone give me a solution?
Thanks in advance.
 
I would have thought the serial number would be the same regardless of how many partitions are on the disk.?

What exactly are you trying to do?
 
harddisk serial:
Code:
Function GetPhysicalSerial() As Variant

    Dim obj As Object
    Dim wmi As Object
    Dim SNList() As String, i As Long, count As Long
    
    Set wmi = GetObject("WinMgmts:")
    
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        If obj.SerialNumber <> "" Then count = count + 1
    Next
    
    'ReDim SNList(1 To Count, 1 To 1)
    ReDim SNList(1 To count)
    
    i = 1
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        'SNList(i, 1) = obj.SerialNumber
        SNList(i) = Trim(obj.SerialNumber & "")
        Debug.Print Trim(obj.SerialNumber & "")
        i = i + 1
        If i > count Then Exit For
    Next
    
    GetPhysicalSerial = SNList(1)
End Function
 
Here you go...
Code:
'---------------------------------------------------------------------------------------
' Procedure : GetHdNum
' Date      : 11/16/2017
' Purpose   :Returns the serial number of the HDD
'---------------------------------------------------------------------------------------
'
Function GetHdNum() As String

    Dim fsObj   As Object
    Dim drv     As Object

    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives("C")

   'Use Hex to convert to string
    'Trim to remove spaces
    GetHdNum = Trim(Hex(drv.SerialNumber))
   ' Debug.Print GetHdNum
    
End Function

NOTE: Very rarely hard drives don't return a value. You may need to enclose the drv.SerialNumber section with Nz if that's an issue
 
I would have thought the serial number would be the same regardless of how many partitions are on the disk.?

What exactly are you trying to do?
Gasman, actually I want to lock my excel program so that it only works on single system, I used drive C serial, but it has a problem that the serial of drive C is not fixed and it changes with the windows change., so I need a permanent serial on system, after searches I figure out HDD serial or CPU serial is fixed and I can use it in my program.
 
harddisk serial:
Code:
Function GetPhysicalSerial() As Variant

    Dim obj As Object
    Dim wmi As Object
    Dim SNList() As String, i As Long, count As Long
   
    Set wmi = GetObject("WinMgmts:")
   
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        If obj.SerialNumber <> "" Then count = count + 1
    Next
   
    'ReDim SNList(1 To Count, 1 To 1)
    ReDim SNList(1 To count)
   
    i = 1
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        'SNList(i, 1) = obj.SerialNumber
        SNList(i) = Trim(obj.SerialNumber & "")
        Debug.Print Trim(obj.SerialNumber & "")
        i = i + 1
        If i > count Then Exit For
    Next
   
    GetPhysicalSerial = SNList(1)
End Function
Thank you arnelgp, It works well, but it returns several serials, that are USB serial, my external hard and HDD serial. is there a way to get only Hard disk serial and not the other (flash memory, hard external) serials?
 
change the function to this.
it will correctly return the "first" harddisk serial.
you can comment out the lines I comment to
see what is going on.
Code:
' credit to my book:
' managing enterprise systems
' with the windows script host
'
' by stein borge
' (c) 2002
' apress
'
' pg.285
'
' arnelgp
'
Public Function HDSerialNumber() As String
Dim strComputer As String
Dim objWMIService As Object
Dim ObjItem As Object
Dim ColItems As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set ColItems = objWMIService.ExecQuery( _
                                        "SELECT * FROM Win32_DiskDrive")
Dim i As Integer
For Each ObjItem In ColItems
    'Debug.Print i, ObjItem.NAME, ObjItem.SerialNumber
    'i = i + 1
    If InStr(ObjItem.NAME, "PHYSICALDRIVE0") > 0 Then
        HDSerialNumber = ObjItem.SerialNumber
    End If
Next
End Function
 
change the function to this.
it will correctly return the "first" harddisk serial.
you can comment out the lines I comment to
see what is going on.
Code:
' credit to my book:
' managing enterprise systems
' with the windows script host
'
' by stein borge
' (c) 2002
' apress
'
' pg.285
'
' arnelgp
'
Public Function HDSerialNumber() As String
Dim strComputer As String
Dim objWMIService As Object
Dim ObjItem As Object
Dim ColItems As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set ColItems = objWMIService.ExecQuery( _
                                        "SELECT * FROM Win32_DiskDrive")
Dim i As Integer
For Each ObjItem In ColItems
    'Debug.Print i, ObjItem.NAME, ObjItem.SerialNumber
    'i = i + 1
    If InStr(ObjItem.NAME, "PHYSICALDRIVE0") > 0 Then
        HDSerialNumber = ObjItem.SerialNumber
    End If
Next
End Function
Thanks a lot arnelgp, is the serial (hard disk serial) unique for every computer?
 
it should be unique for each computer.
 
Very interesting. I tried arnel's first version and got a list of five serials which is what I want. The Samsung SSD drive printed the correct serial number printed on the label of the drive. The Western Digital drive prints a prefix of WD- in front of the actual serial number printed on the drive itself. I can use this for a different purpose of verifying installed hard drives on windows machines but it's strange how some serial numbers match the printed number on the drive and like my Western Digital drive, it has the prefix. So to get the serial number on the label of the drive, that prefix would have to be stripped off in my case.

I guess I need to brush up on windows wmi as I'll most likely use it in Powershell script instead.
 
Hi. I'm too late to the party, but just in case it adds any new information, I offer the following article. Cheers!

 
Hi arnelgp, with your first Function (GetPhysicalSerial), it gives the right serial of hard : WD-WX71A1425422 , but the second function returns :
2020202057202d44585731373141323434353232
Of course, two functions returns single serial on my system, but I have the problem on another system. I guess the second function result is Hex of HDD serial.
 
Last edited:
im not sure if it is hex.
in any way, it will be unique on each system.
 
im not sure if it is hex.
in any way, it will be unique on each system.
Your first function is great, is it possible to get only serial of PHYSICALDRIVE0 in the first function? for example :

For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
if obj.Name = PHYSICALDRIVE0 then
.....
.....
.....
Next
 
hH
harddisk serial:
Code:
Function GetPhysicalSerial() As Variant

    Dim obj As Object
    Dim wmi As Object
    Dim SNList() As String, i As Long, count As Long
   
    Set wmi = GetObject("WinMgmts:")
   
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        If obj.SerialNumber <> "" Then count = count + 1
    Next
   
    'ReDim SNList(1 To Count, 1 To 1)
    ReDim SNList(1 To count)
   
    i = 1
    For Each obj In wmi.InstancesOf("Win32_PhysicalMedia")
        'SNList(i, 1) = obj.SerialNumber
        SNList(i) = Trim(obj.SerialNumber & "")
        Debug.Print Trim(obj.SerialNumber & "")
        i = i + 1
        If i > count Then Exit For
    Next
   
    GetPhysicalSerial = SNList(1)
End Function
How do i get the serial number and put it in a field in the table
 
How do i get the serial number and put it in a field in the table
you put the code in a Module and create a query.
if you have already record on your table, use Update query, otherwise use Insert query:

Update yourTable Set FieldToPutSerial = GetPhysicalSerial();

for insert

Insert Into yourTable ( FieldToPutSerial ) Select GetPhysicalSerial();

or you can just run the function in Immediate Window in VBA and copy/paste it into the field.
 

Users who are viewing this thread

Back
Top Bottom