开发背景：写了一个exe需要绑定U盘使用，找了一圈没几个好用的，索性自己编了一个！
开发环境：Win10工作站版+VB6.0
使用方法：打开即可使用，软件运行会自动侦测是否插入U盘，有的话自动获取盘符和ID，没有插入的话自动提示！

是用的Win32_USBHub类的DeviceID属性值吗？你那怎么全是数字？

对了一半，通过上面方法获取U盘盘符，然后根据盘符获取数字ID...

Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
For Each objItem In colItems
a = objItem.DeviceID  'U盘识别为:USB\VID_09A6&PID_800\20040418154911-00，故用VID判别
If InStr(a, "VID") Then b = Split(a, "\"): MsgBox b(UBound(b))
Next

能实现软件效果吗？

U盘的硬件ID只能长下面这样，看图：

想要达到你一楼中纯数字的效果，要不我们只保留字符串中的数字试试看。

这个U盘ID获取器有点误人子弟。楼主不要相信，以cmd 显示为准。

同一个U盘，看图：

U盘快递寄过来我看下什么鬼

自己做的一个U盘PE维护盘而已。

原来是这么回事。

Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" ( _
    ByVal lpRootPathName As String, _
    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

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" ( _
    ByVal nDrive As String) As Long

' 获取磁盘序列号（纯数字）
Public Function GetDiskID(ByVal drive As String) As String
    Dim volName As String
    Dim fsName As String
    Dim serial As Long
    Dim maxCompLen As Long
    Dim fsFlags As Long
    Dim ret As Long

    volName = String(256, 0)
    fsName = String(256, 0)

    If Right$(drive, 1) <> "\" Then drive = drive & "\"

    ret = GetVolumeInformation( _
        drive, _
        volName, Len(volName), _
        serial, _
        maxCompLen, _
        fsFlags, _
        fsName, Len(fsName))

    If ret = 0 Then
        GetDiskID = ""
    Else
        GetDiskID = CStr(SerialToUnsigned(serial))
    End If
End Function

Private Function SerialToUnsigned(ByVal s As Long) As Double
    If s < 0 Then
        SerialToUnsigned = s + 4294967296# ' 2^32
    Else
        SerialToUnsigned = s
    End If
End Function

' 获取所有可移动磁盘
Public Function GetAllUSBDrives() As Collection
    Dim i As Integer
    Dim drv As String
    Dim col As New Collection

    For i = 65 To 90 ' A-Z
        drv = Chr$(i) & ":\"
        If GetDriveType(drv) = 2 Then ' 2 = DRIVE_REMOVABLE
            col.Add drv
        End If
    Next i

    Set GetAllUSBDrives = col
End Function

Private Sub Form_Load()
    Dim col As Collection
    Dim drv As Variant
    Dim id As String
    Dim msg As String

    Set col = GetAllUSBDrives()

    If col.Count = 0 Then
        MsgBox "未检测到U盘"
        Exit Sub
    End If

    msg = ""
    For Each drv In col
        id = GetDiskID(drv)
        msg = msg & "U盘盘符：" & drv & vbCrLf & "U盘ID（纯数字）：" & id & vbCrLf & vbCrLf
    Next drv

    MsgBox msg
End Sub