朋友要的 VB读取优盘物理序列号

 以前的有一个别人写的这个代码，也是使用WMI的，不过效率好像高一些。今天看到朋友要，想找来着。结果没有找到。只好重新自己写了一个，效率有点低，没以前那个好，回头再慢慢找找看看是不是存别的地方了。

Public Function GetUDiskID() As String
    '**********************
    '*Function:读取优盘物理序列号
    '*
    '*Author:张旋(zxsoft)
    '**********************
    On Error Resume Next
    Dim objWMIService As Object
    Dim colDevices As Object
    Dim objdevice As Object
    Dim UDiskID As String
    Dim isUDisk As Boolean
    Dim objUsbDevice As Object
    Dim colUSBDevices As Object
    isUDisk = False
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colDevices = objWMIService.ExecQuery _
        ("Select * From Win32_USBControllerDevice")
    Dim ret
    For Each objdevice In colDevices
        Set colUSBDevices = objWMIService.ExecQuery _
            ("Select * From Win32_PnPEntity Where DeviceID = '" & Split(Replace(objdevice.Dependent, Chr(34), ""), "=")(1) & "'")
        For Each objUsbDevice In colUSBDevices
            If Left(objUsbDevice.DeviceID, 8) = "STORAGE\" Then
                GetUDiskID = UDiskID
                Exit Function
            End If
            If Left(objUsbDevice.DeviceID, 8) = "USB\VID_" Then
                UDiskID = Split(objUsbDevice.DeviceID, "\")(2)
                If InStr(UDiskID, "&") > 0 Then
                    ret = Split(UDiskID, "&")
                    UDiskID = ret(UBound(ret) - 2)
                End If
            End If
        Next
    Next
    GetUDiskID = "U-Disk-Not-Found"
End Function

终于找到那个读序列号的代码了！原来放在gmail里啦！帖出来吧！ 就是比我写的好呀

Sub cc()
    On Error Resume Next
    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 a Like "*VID*" Then b = Split(a, "\"): MsgBox b(UBound(b))
        '上句亦可:If InStr(a, "VID") Then b = Split(a, "\"): MsgBox b(UBound(b))
    Next
End Sub