Может это поможет.
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As Long, ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Public Function SerialVolume() As String
Dim a As String
Dim b As String
Dim s As Long
Dim ml As Long
Dim fl As Long

a = Chr(0) & String(255, " ")
b = Chr(0) & String(255, " ")

GetVolumeInformation 0, a, Len(a), s, ml, fl, b, Len(b)
If s < 0 Then s = -s 'на некоторых машинах номер винта - отрицательное значение

SerialVolume = s
End Function

вот такое не поможет?

===================================================================
Как узнать реальный заводской номер физического диска или дискеты или CD,
не номер метки тома (он меняется при каждом форматировании носителя)
а заводской серийник который записиваеться производителем и никогда не меняеться.

On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

arrComputers = Array("localhost")
For Each strComputer In arrComputers
WScript.Echo
WScript.Echo "=========================================="
WScript.Echo "Computer: " & strComputer
WScript.Echo "=========================================="

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PhysicalMedia", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)

For Each objItem In colItems
WScript.Echo "SerialNumber: " & objItem.SerialNumber
WScript.Echo
Next
Next
===================================================================