Find the drive letter of an USB device

euklides

New Member
Joined
Aug 10, 2017
Messages
2
Hello !
As you know, the letter of an USB device can change.
If you need to use a USB device in your VBA application, use this:
Code:
'declaration
Public DRIVELETTER
Public Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
'sub
Sub FINDDRIVELETTER()
'DRIVELETTER="?": show on screen then connected drives (name, fat, serial)
'DRIVELETTER= 'serial number' (9 characteres) or 'device name' --> return the drive lettre
'by euklides, April 2018
LETTER$ = "": INFODRIVE$ = ""
Dim Serial As Long, VName As String, FSName As String
For LETTERNUM = 65 To 90: U$ = Chr$(LETTERNUM)
 VName = String$(255, Chr$(0)): FSName = String$(255, Chr$(0)): Serial = 0
 GetVolumeInformation U$ + ":\", VName, 255, Serial, 0, 0, FSName, 255
 If Serial <> 0 Then
  VName = Left$(VName, InStr(1, VName, Chr$(0)) - 1):  FSName = Left$(FSName, InStr(1, FSName, Chr$(0)) - 1)
  WW = Serial: seri$ = Left$(Hex$(WW), 4) + "-" + Right$(Hex$(WW), 4)
  zz$ = U$ + ":  name: " + "{" + VName + "} " + " system: {" + FSName + "} " + "serial: { " + seri$ + " )"
 INFODRIVE$ = INFODRIVE$ + zz$ + Chr$(10)
 If Len(DRIVELETTER) > 2 And InStr(UCase(zz$), UCase$(DRIVELETTER)) > 0 Then LETTER$ = Left$(zz$, 1)
End If
Next LETTERNUM
If DRIVELETTER = "?" Then MsgBox INFODRIVE$, vbOKOnly + vbInformation, "CONNECTED DRIVES: name, fat, serial ": GoTo Fino
If DRIVELETTER <> "" And LETTER$ <> "" Then DRIVELETTER = LETTER$: GoTo Fino
DRIVELETTER = DRIVELETTER + " is not currently connected..."
Fino:
End Sub

Using:
Code:
Sub TEST()

'if you want to see the name, fat, serial of your connected usb drives
DRIVELETTER = "?"
FINDDRIVELETTER


'You have a usb key or usb HDD on which you want to open a file
'You know that the serial number is, for instance 0955-CA88

'So you write:
DRIVELETTER = "0955-CA88"
FINDDRIVELETTER
If Len(DRIVELETTER) > 1 Then MsgBox DRIVELETTER: End
'Now you can open your file on the USB device
file$ = DRIVELETTER + ":\myfiles\Example.txt"
Close 1: Open file$ For Input As 1
'....

End Sub
Hope it can help !
:)
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Watch MrExcel Video

Forum statistics

Threads
1,108,973
Messages
5,525,988
Members
409,673
Latest member
Riseee

This Week's Hot Topics

Top