Récupérer la lettre des lecteurs réseau
Tu peux utiliser l'un de ces codes. Il y a en tout 3 modules de code différents et indépendants les uns des autres. Le dernier te propose une autre approche (API) que le FileSystemObject pour récupérer la liste des lecteurs disponibles, y compris réseau.
'module 1 'Ouvrir un fichier avec GetOpenFilename en fournissant comme répertoire 'par défaut pour l'ouverture un répertoire distant 'The following seems to work for me. It relies on the the Windows API 'function SetCurrentDirectoryA to set the current path. This function will 'take UNC paths or mapped drives as arguments. Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long sub SetUNCPath() 'Rob Bovey, mpep Dim szPath As String Dim szTest As String szPath = "\DELLNT\InstallationFiles" SetCurrentDirectoryA szPath szTest = Application.GetOpenFilename() end sub
'module 2 'retrouver le nom UNC (uniform (universal ?) naming convention) d'un lecteur 'à partir de son nom local 'Gary Brown et Harlan Grove, mpep Public Declare Function WNetGetConnection Lib "mpr.dll" _ Alias "WNetGetConnectionA" _ (ByVal lpszLocalName As String, _ ByVal lpszRemoteName As String, _ cbRemoteName As Long) As Long sub UNCfromLocal1() 'Find UNC from Local path 'i.e. Local drive "F:" = "\RdaServer3\sys1" Dim sLocal As String Dim sRemote As String * 255 Dim lLen As Long sRemote = String$(255, Chr$(32)) lLen = 255 sLocal = "F:" '<===== adapter ici selon besoin WNetGetConnection sLocal, sRemote, lLen MsgBox sRemote end sub
'la procédure ci-dessus a été transformée en fonction par 'Harlan Grove, mpep
Function UNCFromLocal(sLocal As String) As String 'Find UNC from Local path 'e.g., Local drive "F:" = "\RdaServer3\sys1" Dim sRemote As String * 255 Dim lLen As Long sRemote = String$(255, Chr$(32)) lLen = 255 Call WNetGetConnection(sLocal, sRemote, lLen) UNCFromLocal = sRemote End Function
'le même Harlan Grove propose de plus cette fonction pour 'renvoyer le nom de volume du lecteur UNC
Function VolumeLabelFromUNC(unc As String) As String
Dim n As Long
n = InStr(3, unc, "")
If n > 2 Then
VolumeLabelFromUNC = Mid(unc, n + 1) & " on '" & _
Mid(unc, 3, n - 3) & "'"
Else
VolumeLabelFromUNC = "on '" & _
Mid(unc, 3, n - 3) & "'"
End If
End Function
'module 3
Declare Function GetDriveType Lib "kernel" _
(ByVal DriveNumber As Integer) As Integer
Declare Function GetDriveTypeA Lib "kernel32" _
(ByVal DriveNumber As String) As Integer
' Drive Types
' 0 = Drive Unknown
' 1 = No Root Directory
' 2 = Removable
' 3 = Hard disk
' 4 = Remote (network) drive
' 5 = CD ROM
' 6 = RAM Disk
sub ListAvailDrives()
'Jim Rech, mpep
Dim DrvCtr As Integer, Success As Integer, ListCtr As Integer
Sheets(1).Range("A1:B26").ClearContents
If InStr(1, Application.OperatingSystem, "32") <> 0 Then
For DrvCtr = Asc("A") To Asc("Z")
Success = GetDriveTypeA(Chr(DrvCtr) & ":")
If Success <> 0 And Success <> 1 Then
ListCtr = ListCtr + 1
With Sheets(1)
.Cells(ListCtr, 1) = Chr(DrvCtr)
.Cells(ListCtr, 2) = Success
End With
End If
Next
Else
For DrvCtr = Asc("A") - 65 To Asc("Z") - 65
Success = GetDriveType(DrvCtr)
If Success Then
ListCtr = ListCtr + 1
With Sheets(1)
.Cells(ListCtr, 1) = Chr(DrvCtr + 65)
.Cells(ListCtr, 2) = Success
End With
End If
Next
End If
end sub
Auteurs : Harlan Grove, Frédéric Sigonneau
Mots clefs associés à cette page : réseau, lettre, lecteur
- Vous devez vous identifier ou créer un compte pour écrire des commentaires
