Dim objWMI, objLogicalDisks, objLD
Dim objPartitions, objPart, objDrives, objDrive
Dim strComputer, strTemp

     strComputer = "."
     Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\cimv2")
     Set objLogicalDisks = objWMI.ExecQuery _
                         ("SELECT * FROM Win32_LogicalDisk WHERE DriveType=2")
     For Each objLD In objLogicalDisks
         Set objPartitions = objWMI.ExecQuery _
                                 ("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID=""" & _
                                 objLD.DeviceID & _
                                 """} WHERE AssocClass=Win32_LogicalDiskToPartition")
         For Each objPart In objPartitions
             Set objDrives = objWMI.ExecQuery _
                                 ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
                                 objPart.DeviceID & _
                                 """} WHERE AssocClass=Win32_DiskDriveToDiskPartition")
             For Each objDrive In objDrives
                 strTemp = strTemp & objLD.DeviceID & " => " & objDrive.Caption & " (Диск " & objDrive.Index & ")" & vbNewLine & _
                             "SerialNumber накопителя = " & objDrive.SerialNumber & vbNewLine & vbNewLine
             Next
             Set objDrive = Nothing
             Set objDrives = Nothing
         Next
         Set objPart = Nothing
         Set objPartitions = Nothing
     Next
     If Len(strTemp) = 0 Then
         strTemp = "Накопителей указанного типа не найдено."
     End If
     Set objLD = Nothing
     Set objLogicalDisks = Nothing
     Set objWMI = Nothing

  strTemp = strTemp & objLD.DeviceID & " => " & objDrive.Caption & " (Диск " & objDrive.Index & ")" & vbNewLine & _
                             "SerialNumber накопителя = " & objDrive.SerialNumber & vbNewLine & vbNewLine