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 !
:)
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top