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に表示されると同時にクリップボードにコピーされます。