Récupération de lettre de lecteur réseau
JLNoury
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.
J'ai repris l'exemple fourni dans l'aide VBA que j'ai testé sur divers
chemins du réseau et qu'il y ait un lecteur connecté ou non, je récupère
toujours une chaîne vide à la place de la lettre de lecteur. Comportement
qui est normal uniquement lorqu'il n'y a pas de lecteur mappé.
Texte de la macro :
=============
Sub test()
AfficheInfoLecteur ("\\10.165.122.37\c$")
End Sub
--------------------------------------------------------
Sub AfficheInfoLecteur(drvPath)
Dim fs, d, s, t, l
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(drvPath)
Select Case d.DriveType
Case 0: t = "Inconnu"
Case 1: t = "Amovible"
Case 2: t = "Fixe"
Case 3: t = "Réseau"
Case 4: t = "CD-ROM"
Case 5: t = "Disque RAM"
End Select
s = "Lecteur " & d.driveletter & ": - " & t
l = d.driveletter
If d.IsReady Then
s = s & vbCrLf & "Lecteur prêt."
Else
s = s & vbCrLf & "Lecteur non prêt."
End If
MsgBox s
End Sub
====================================================
Auriez-vous une idée sur la question qui pourrait m'aider ?
Merci d'avance
Jean-Luc
Frédéric Sigonneau
Ces morceaux de code récupérés sur le forum anglophone peuvent peut-être t'aider
à te décoincer. Si tu trouves ton bonheur dedans, pourras-tu le faire savoir ?
(je ne peux pas travailler en réseau, aussi ton expérience pourra-t-elle servir
à d'autres...).
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.
FS
--
Frédéric Sigonneau [né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
'======================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
'les deux fonctions peuvent s'utiliser en conjonction dans
'une feuille de calcul :
' = VolumeLabelFromUNC(UNCfromLocal("N:"))
'==============================
'======================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
'==============================
JLNoury a écrit :
JLNoury
Ca marche impeccablement.
Il m'a suffit de comparer au chemin UNC recherché le chemin UNC récupéré
pour chaque lecteur et à le stcocker dans une variable et le problème est
réglé.
Merci pour ton aide
Jean-Luc
"Frédéric Sigonneau" <frederic....@wanadoo.fr> a écrit dans le message
de news: 3C9F9520...@wanadoo.fr...