カスタム検索
Office関連

USBメモリのシリアルナンバー取得する(Excel VBA)

こちらでUSBメモリのシリアルナンバーを取得するVBScriptを紹介していますが、今回はExcel VBAでドライブレターを指定してUSBメモリのシリアルナンバー取得する方法を紹介します。
コード自体は下記Webページ、Hey, Scripting Guy!のものを流用しました。

「Hey, Scripting Guy! 論理ドライブと物理ディスクを相互に関連付ける方法はありますか」
http://gallery.technet.microsoft.com/scriptcenter/1abfce9f-d531-440e-9500-b9d7d2e454df

[標準モジュール]

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 & "\root\cimv2")

  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
        '指定したドライブレターの場合の処理
        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

下記コードのようにドライブレターを引数にして呼び出せば、USBメモリのシリアルナンバーを取得することができます。
ただ、「USBSTOR\DISK&VEN_IMATION&PROD_USB_FLASH_DRIVE&REV_0.00 \5F855B37D045C5&0」のようにすべてを取得するのは長いのでSplitで最後の「5F855B37D045C5&0」だけ取得するようにしています。

Sub Call_Func()
  MsgBox GetPNPDeviceID("L:")
End Sub

また、上記Functionをユーザーフォームから呼び出して、ダイアログで選択したドライブ(USBメモリ)のシリアルナンバーを取得することもできます。
GetPNPDeviceID.xls

(1)ボタンを押してダイアログからドライブを選択すれば、

(2)シリアルナンバーがTextBoxに表示されると同時にクリップボードにコピーされます。