Changing drive letter in VBA

[Guest]

For mobility reasons, I store all my VBA programmes in a thumb drive (USB).
And in some of my VBA programmes, also contain the drive path with the
associated drive letters. (e.g. opening a file)

As I add more USB devices to my PC, these drive letters keep changing such
that the VBA programme can't read the correct drive letter where the files
are stored.

Any solution to fix the drive letter? Thanks.

zhj23

 

[Zone]

I had a sorta similar problem caused by putting my files on other
computers that used network drives that kept getting assigned
different drive letters. My solution was that I added a Control
worksheet to my files. I named one of the cells in that sheet
DriveLoc and put the drive specification in there. Then I just got
the drive spec from that sheet and put it in a string variable named
DrivePath and concatenated it with the rest of the filepath anywhere
in my program that was going to use the network drive. Maybe not an
ideal solution, but at least you have to change the drive spec in only
one place! I guess you could alternatively use a global constant to
hold the drive spec. It was easier for my users to change it on the
Control sheet. HTH, James

 

[Peter T]

Perhaps a bit of brute force -

Sub test3()
Dim bRes As Boolean
Dim nFirstDriveToSearch As Long
Dim sKnownFile As String
Dim sDrive As String

nFirstDriveToSearch = Asc("E") ' or simply 69 (maybe start with C)

' a known file that only exists in the drive to be found
sKnownFile = "aler.ini" ' this in root but could add folder

bRes = GetMyDrive(nFirstDriveToSearch, sKnownFile, sDrive)

If bRes Then
MsgBox sDrive
Else
MsgBox "not found"
End If

End Sub

Function GetMyDrive(nChr As Long, sFile As String, sDrive As String) As
Boolean
Dim bRes As Boolean
On Error Resume Next
For i = nChr To Asc("Z")
sDrive = Chr(i) & ":\"
bRes = False
bRes = GetAttr(sDrive) = vbDirectory
If bRes Then
bRes = fbFileExists(sDrive & sFile)
If bRes Then
Exit For
End If
End If
Next
GetMyDrive = bRes
End Function

Function fbFileExists(ByVal sFile As String) As Boolean
Dim nAttr As Long

On Error Resume Next
nAttr = GetAttr(sFile)
fbFileExists = (Err.Number = 0) And ((nAttr And vbDirectory) = 0)
On Error GoTo 0

End Function

Regards,
Peter T

 

[Guest]

Thanks for the various suggestions. I would look into them.

zhj23.

 

[Guest]

Thanks for the various suggestions. I would look into them.

zhj23.

Maybe you could also try naming your USB drives and then getting the drive
letter:

Sub getUSBDrive()

Set fso = CreateObject _
("Scripting.FileSystemObject")

For Each drive In fso.Drives

If drive.IsReady Then
If UCase(drive.VolumeName) = "MYUSBDRIVE" Then
Debug.Print drive.VolumeName, drive.DriveLetter
End If
End If

Next

End Sub