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:
Using:
Hope it can help !
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