APIs: Enumération des disques locaux et de ceux sur réseau	Author(s) Dev Ashish

(Q) Est-il possible de connaître toutes les lettres assignées aux disques locaux et la description "UNC" des connexions par réseau établies sur un PC?

(A) Vous pouvez avoir à contrôler la présentation du résultat, utiliser la sous-routine  sListAllDrives comme source d'inspiration pour énumérer la liste des disques. Couper-coller le code dans un nouveau module.

'************ Code Start **************
'Ce code fut originalement écrit par Terry Kreft
'et par Dev Ashish. 
'Il ne doit être ni altéré, ni distribué
'sauf comme partie intégrée à une application.
'Vous êtes libre d'utiliser ce code 
'à la condition de laisser cette note, sans modification.
<
' Original Code by Terry Kreft
' Modified by Dev Ashish
'
'Drive Types
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
        "WNetGetConnectionA" (ByVal lpszLocalName As String, _
        ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
    "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
Private Function fGetDrives() As String
'Returns all mapped drives
    Dim lngRet As Long
    Dim strDrives As String * 255
    Dim lngTmp As Long
    lngTmp = Len(strDrives)
    lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
    fGetDrives = Left(strDrives, lngRet)
End Function
Private Function fGetUNCPath(strDriveLetter As String) As String
    On Local Error GoTo fGetUNCPath_Err

    Dim Msg As String, lngReturn As Long
    Dim lpszLocalName As String
    Dim lpszRemoteName As String
    Dim cbRemoteName As Long
    lpszLocalName = strDriveLetter
    lpszRemoteName = String$(255, Chr$(32))
    cbRemoteName = Len(lpszRemoteName)
    lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _
                                       cbRemoteName)
    Select Case lngReturn
        Case ERROR_BAD_DEVICE
            Msg = "Error: Bad Device"
        Case ERROR_CONNECTION_UNAVAIL
            Msg = "Error: Connection Un-Available"
        Case ERROR_EXTENDED_ERROR
            Msg = "Error: Extended Error"
        Case ERROR_MORE_DATA
               Msg = "Error: More Data"
        Case ERROR_NOT_SUPPORTED
               Msg = "Error: Feature not Supported"
        Case ERROR_NO_NET_OR_BAD_PATH
               Msg = "Error: No Network Available or Bad Path"

        Case ERROR_NO_NETWORK
               Msg = "Error: No Network Available"
        Case ERROR_NOT_CONNECTED
               Msg = "Error: Not Connected"
        Case NO_ERROR
               ' all is successful...
    End Select
    If Len(Msg) Then
        MsgBox Msg, vbInformation
    Else
        fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)
    End If
fGetUNCPath_End:
    Exit Function
fGetUNCPath_Err:
    MsgBox Err.Description, vbInformation
    Resume fGetUNCPath_End
End Function

Private Function fDriveType(strDriveName As String) As String
    Dim lngRet As Long
    Dim strDrive As String
    lngRet = GetDriveType(strDriveName)
    Select Case lngRet
        Case DRIVE_UNKNOWN 'Disque de type non déterminé
            strDrive = "Unknown Drive Type"
        Case DRIVE_ABSENT 'La racine (root directory) n'existe pas
            strDrive = "Drive does not exist"
        Case DRIVE_REMOVABLE 'Le disque peut être retiré du lecteur
            strDrive = "Removable Media"
        Case DRIVE_FIXED 'Le disque ne peut pas être retiré du lecteur
            strDrive = "Fixed Drive"
        Case DRIVE_REMOTE  'Le disque est sur une autre station (network)
            strDrive = "Network Drive"
        Case DRIVE_CDROM 'Il s'agit d'un lecteur CD
            strDrive = "CD Rom"
        Case DRIVE_RAMDISK 'Le disque est abstrait en mémoire (ramdisk)
            strDrive = "Ram Disk"
    End Select
    fDriveType = strDrive
End Function

Sub sListAllDrives()
    Dim strAllDrives As String
    Dim strTmp As String
    
    strAllDrives = fGetDrives
    If strAllDrives <> "" Then
        Do
            strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
            strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
            Select Case fDriveType(strTmp)
                Case "Removable Media":
                    Debug.Print "Removable drive :  " & strTmp
                Case "CD ROM":
                    Debug.Print "   CD Rom drive :  " & strTmp
                Case "Fixed Drive":
                    Debug.Print "    Local drive :  " & strTmp
                Case "Network Drive":
                    Debug.Print "  Network drive :  " & strTmp
                    Debug.Print "       UNC Path :  " & _
                                fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))
            End Select
        Loop While strAllDrives <> ""
    End If
End Sub,br>'**************** Code End ******************

en faisant suivre d'un retour de chariot.