Récupérer la lettre des lecteurs réseau

J'ai fait une petite macro censée traiter des fichiers se trouvant sur un répertoire partagé d'un serveur du réseau. Cette macro est destinée à être lancée de divers postes du réseau. Ces postes n'ayant pas toujours les mêmes lettres mappées sur les mêmes répertoires, j'ai besoin de récupérer la lettre du lecteur connecté à ce chemin. Comment faire ?

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 : ,

Mots clefs associés à cette page : , ,