有偿求：读取U盘序列号的VBA(格式化后不变)

Question

求一段能读取U盘序列号的VBA，要求U盘格式化后不会改变，愿出50元回报！
谢谢！

Answer 1

要求所输的盘符格式为 F:    Dim Fso As Object    Set Fso = CreateObject("Scripting.FileSystemObject")
    MsgBox Fso.getdrive(InputBox("请输入U盘盘符：") & "\").serialnumber

Answer 2

为什么要用U盘的盘符序列号来判断设备呢?直接用设备ID不好吗?

Answer 3

Function 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, "\")
        CC = b(UBound(b))
        '上句亦可:If InStr(a, "VID") Then b = Split(a, "\"): MsgBox b(UBound(b))
    Next
End Function