'Example by Alexey (alexeyka2001@rambler.ru)
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 'The drive type cannot be determined.
            strDrive = "Unknown Drive Type"
        Case DRIVE_ABSENT 'The root directory does not exist.
            strDrive = "Drive does not exist"
        Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
            strDrive = "Removable Media"
        Case DRIVE_FIXED 'The disk cannot be removed from the drive.
            strDrive = "Fixed Drive"
        Case DRIVE_REMOTE  'The drive is a remote (network) drive.
            strDrive = "Network Drive"
        Case DRIVE_CDROM 'The drive is a CD-ROM drive.
            strDrive = "CD Rom"
        Case DRIVE_RAMDISK 'The drive is a RAM disk.
            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

Private Sub Form_Load()
    Debug.Print "All available drives: "
    sListAllDrives
End Sub