I decided to use late binding so you won't need to set a ref to the WMI
library. Otherwise, just run the code. At the end is a Sub to test a
drive for being a USB volume. My goal was to make this as simple as
possible (which I think I accomplished that), and so now I'll use this
code to replace my proprietary stuff.<g>
HTH
Paste the following code in a standard module...
Option Explicit
'32-bit API declarations required for folder selection
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Type declarations
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Function Get_UsbDriveInfo$()
Dim sPath$, sDrvLetter$, sDrvIndex$, oWMI, vDrv, vDrives, i%, iPos%
'Solicit user for the path to the target drive
sPath = GetDirectory: If sPath = "" Then Exit Function
'We only want the drive letter
sPath = Left$(sPath, 1)
On Error GoTo ErrExit
Set oWMI =
GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set vDrives = oWMI.ExecQuery("Select * from
Win32_LogicalDiskToPartition")
i = 0
For Each vDrv In vDrives
'First match the drive letter
sDrvLetter = vDrv.Dependent: iPos = InStr(1, sDrvLetter, "=")
sDrvLetter = Mid$(sDrvLetter, iPos + 2, 1)
If sDrvLetter = sPath Then '//get its Index
sDrvIndex = vDrv.Antecedent: iPos = InStr(1, sDrvIndex, "#")
sDrvIndex = Mid$(sDrvIndex, iPos + 1, InStr(1, sDrvIndex, ",") -
(iPos + 1))
Exit For
End If
Next 'vDrv
'Verify it's a USB drive
Set vDrives = oWMI.ExecQuery("Select * from Win32_DiskDrive where
InterfaceType = ""USB""")
For Each vDrv In vDrives
If vDrv.Index = sDrvIndex Then
Get_UsbDriveInfo = Join(Array(vDrv.Model, vDrv.PnpDeviceID,
vDrv.Size), ":")
Exit For
End If
Next 'vDrv
ErrExit:
Set oWMI = Nothing: Set vDrives = Nothing
End Function 'Get_UsbDriveInfo
Function GetDirectory$(Optional Msg$)
' Opens the browse dialog for picking a folder
Dim bInfo As BROWSEINFO
Dim sPath$, r&, x&, iPos%
'Root folder = Desktop
bInfo.pidlRoot = 0&
'Title the dialog
If Msg = "" Then Msg = "Select a folder."
bInfo.lpszTitle = Msg
'Type of directory to return
bInfo.ulFlags = &H1
'Display the dialog
x = SHBrowseForFolder(bInfo)
'Parse the result
sPath = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal sPath)
If r Then
iPos = InStr(sPath, Chr$(0))
GetDirectory = Left(sPath, iPos - 1)
Else
GetDirectory = ""
End If
End Function 'GetDirectory
Sub Test_Get_UsbDriveInfo()
Dim sMsg$
If Len(Get_UsbDriveInfo) Then sMsg = "Valid USB drive" Else sMsg =
"Not a valid USB drive"
MsgBox sMsg
End Sub
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion