GetallDrive




'use as:

'MsgBox GetAllDrives

'this will give you all the drives attached to your system

Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Global Const DRIVE_REMOVABLE = 2
Global Const DRIVE_FIXED = 3
Global Const DRIVE_REMOTE = 4
Global Const DRIVE_CDROM = 5
Global Const DRIVE_RAMDISK = 6
Public Function GetAllDrives() As String
Dim lngResult&, strDrives$, strJustOneDrive$, intPos%, lngDriveType&

strDrives$ = Space$(255)
lngResult& = GetLogicalDriveStrings(Len(strDrives$), strDrives$)

strDrives$ = Left$(strDrives$, lngResult&)

Do
intPos% = InStr(strDrives$, Chr$(0))
If intPos% Then
strJustOneDrive$ = Left$(strDrives$, intPos%)
strDrives$ = Mid$(strDrives$, intPos% + 1, Len(strDrives$))
lngDriveType& = GetDriveType(strJustOneDrive$)
Select Case lngDriveType&
Case DRIVE_CDROM
strBuffer = strBuffer & "CD-Rom: " & strJustOneDrive$ & vbCRLF
Case DRIVE_REMOVABLE
strBuffer = strBuffer & "RemovableDrive: " & strJustOneDrive$ & vbCRLF
Case DRIVE_FIXED
strBuffer = strBuffer & "LocalDrive: " & strJustOneDrive$ & vbCRLF
Case DRIVE_REMOTE
strBuffer = strBuffer & "NetworkDrive: " & strJustOneDrive$ & vbCRLF
Case DRIVE_RAMDISK
strBuffer = strBuffer & "RamDrive: " & strJustOneDrive$ & vbCRLF
End Select

End If

Loop Until strDrives$ = ""
GetAllDrives = strBuffer

End Function











( getalldrive.html )- by Paolo Puglisi - Modifica del 17/12/2023