ドライブレターを指定してUSBメモリのシリアルナンバー取得するFunction

Function GetPNPDeviceID(strDriveLetter As String) As String
  Dim strComputer As String
  Dim strDeviceID As String
  Dim colDiskDrives As Object
  Dim colLogicalDisks As Object
  Dim colPartitions As Object
  Dim objDrive As Object
  Dim objLogicalDisk As Object
  Dim objPartition As Object
  Dim objWMIService As Object
  Dim varPNPDeviceID As Variant

  strComputer = "."
  Set objWMIService = GetObject("winmgmts:\" & strComputer & "rootcimv2")

  Set colDiskDrives = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive")
 
  For Each objDrive In colDiskDrives
    strDeviceID = Replace(objDrive.DeviceID, "", "\")
    Set colPartitions = objWMIService.ExecQuery _
      ("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & _
        strDeviceID & """} WHERE AssocClass = " & _
          "Win32_DiskDriveToDiskPartition")
    
    For Each objPartition In colPartitions
      Set colLogicalDisks = objWMIService.ExecQuery _
        ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
          objPartition.DeviceID & """} WHERE AssocClass = " & _
            "Win32_LogicalDiskToPartition")
      
      For Each objLogicalDisk In colLogicalDisks
        '確認用
        'MsgBox "Disk:" & objLogicalDisk.DeviceID & "---" & objDrive.PNPDeviceID
        
        '指定したドライブレターの場合の処理
        If CStr(objLogicalDisk.DeviceID) = strDriveLetter Then
          'PNPDeviceID(Plug and Play device identifier)を""でSplit
          varPNPDeviceID = Split(CStr(objDrive.PNPDeviceID), "")
          GetPNPDeviceID = varPNPDeviceID(UBound(varPNPDeviceID))
          Exit For
        End If
      Next
    Next
  Next
  
End Function

http://blogs.yahoo.co.jp/kinuyo_asami/16010191.html