Liste des répertoires partagés

En VBA bien sûr...

Bonjour HD;
Comme je ne sais pas si tu veux uniquement les répertoires partagés sur le poste
local ou tous ceux du réseau, je t'ai mis la plus
compliquée (réseau en entier).
Attention après copie, supprimer les retours à la ligne parasites provoqués par
Outlook (lignes en rouge).

Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal
dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As
Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA"
(ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As
Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any,
lpFrom As Any, ByVal lLen As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString
As Any) As Long
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
pLocalName As Long
pRemoteName As Long
pComment As Long
pProvider As Long
End Type
Private Type NETRESOURCE_REAL
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
sLocalName As String
sRemoteName As String
sComment As String
sProvider As String
End Type

Sub NetSharedDirList()
Dim First As Boolean, Ret&, hEnum&, Count&, l&, Buffer&, n&, iMin&, iLen&
Dim idx&, Net1(0 To 256) As NETRESOURCE, Net2() As NETRESOURCE_REAL
Cells.ClearContents: First = True
Do
n = n + 1: Application.StatusBar = "Veuillez patienter... [" & n & "]"
If First Then
Ret = WNetOpenEnum(&H2&, &H0&, &H0&, ByVal 0&, hEnum): First = False
Else
If Net2(idx).dwUsage And &H2& Then
Ret = WNetOpenEnum(&H2&, &H0&, &H0&, Net2(idx), hEnum)
Else
Ret = -1: hEnum = 0
End If
idx = idx + 1
End If
If Ret = 0 Then
Count = &HFFFF
Do
Buffer = UBound(Net1) * Len(Net1(0)) / 2
Ret = WNetEnumResource(hEnum, Count, Net1(0), Buffer)
If Count > 0 Then
ReDim Preserve Net2(0 To iMin + Count - 1) As NETRESOURCE_REAL
For l = 0 To Count - 1
Net2(iMin + l).dwDisplayType = Net1(l).dwDisplayType
Net2(iMin + l).dwUsage = Net1(l).dwUsage
If Net1(l).pRemoteName Then
iLen = lstrlen(Net1(l).pRemoteName)
Net2(iMin + l).sRemoteName = Space(iLen)
CopyMem ByVal Net2(iMin + l).sRemoteName, ByVal Net1(l).pRemoteName,
iLen
End If
If Net1(l).pComment Then
iLen = lstrlen(Net1(l).pComment)
Net2(iMin + l).sComment = Space(iLen)
CopyMem ByVal Net2(iMin + l).sComment, ByVal Net1(l).pComment, iLen
End If
Next l
End If
iMin = iMin + Count
Loop While Ret = 234
End If
If hEnum Then l = WNetCloseEnum(hEnum)
Loop While idx < iMin
Application.StatusBar = False
If UBound(Net2) = 0 Then Exit Sub Else n = 0
For l = 0 To UBound(Net2)
If Net2(l).dwDisplayType = &H3 Then
n = n + 1
Cells(n, 1) = Net2(l).sRemoteName
Cells(n, 2) = Net2(l).sComment
End If
Next l
Columns("A:B").Columns.AutoFit
End Sub

MP
Si tu voulais uniquement ceux du poste local, reviens à la charge.

"HD" <hd@anti.spam.fr> a écrit dans le message de
news:btjt6f$2k5$1@biggoron.nerim.net...

Bonjour,

Par quelle commande puis je avoir la liste des répertoires partagés d'un
poste en réseau local?

Sachant que ce poste contient bien effectivement des répertoires partagés et
que ceux ci sont visibles par l'explorateur réseau.

Merci d'avance.
--
@+
David

Merci Michel !!! NetSharedDirList() est de plus très rapide... L'info est
recherchée directement dans le cache de la machine ?

Si tu voulais uniquement ceux du
poste local, reviens à la charge.

Cette autre script m'intéresserait également...

Re HD;
Mêmes précautions d'usage que précédemment.

Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal
dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As
Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA"
(ByVal hEnum As Long, lpcCount As Long, lpBuffer As Any, lpBufferSize As Long) As
Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString
As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1
As Any, ByVal lpString2 As Any) As Long
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Sub LocalSharedDirList()
Dim Status&, hEnum&
Status = WNetOpenEnum(&H1, &H0, 0&, ByVal 0&, hEnum)
If Status <> 0 Then Exit Sub
Dim Net(1023) As NETRESOURCE, iName$, i&, r&, x&
Status = WNetEnumResource(hEnum, 1024, Net(0), CLng(Len(Net(0))) * 1024)
If Status <> 0 Then Exit Sub
Cells.ClearContents
For i = 0 To 1023
If Net(i).lpLocalName = 0 Then Exit For
iName = Space(lstrlen(Net(i).lpLocalName) + 1)
r = lstrcpy(iName, Net(i).lpLocalName)
If Len(iName) Then
x = x + 1
Cells(x, 1) = Left(iName, (Len(iName) - 1))
If Net(i).lpRemoteName Then
iName = Space(lstrlen(Net(i).lpRemoteName) + 1)
r = lstrcpy(iName, Net(i).lpRemoteName)
If Len(iName) Then Cells(x, 2) = Left(iName, (Len(iName) - 1))
End If
End If
Next i
Status = WNetCloseEnum(hEnum)
Columns("A:B").Columns.AutoFit
End Sub

MP

"HD" <hd@anti.spam.fr> a écrit dans le message de
news:btmff8$1jvs$1@biggoron.nerim.net...

Merci Michel !!! NetSharedDirList() est de plus très rapide... L'info est
recherchée directement dans le cache de la machine ?

Si tu voulais uniquement ceux du
poste local, reviens à la charge.

Cette autre script m'intéresserait également...

Remarque que avec les questions que tu poses, tu aurais pu choisir HDD comme
pseudo.
:-))) MP

"HD" <hd@anti.spam.fr> a écrit dans le message de
news:btjt6f$2k5$1@biggoron.nerim.net...

Bonjour,

Par quelle commande puis je avoir la liste des répertoires partagés d'un
poste en réseau local?

Sachant que ce poste contient bien effectivement des répertoires partagés
et

que ceux ci sont visibles par l'explorateur réseau.

Merci d'avance.
--
@+
David