Netzlaufwerk pfade und laufwerksbuchstaben
06.11.2007 10:01:22
chris
ich habe eine frage und würde mich sehr freuen wenn mir jemand helfen könnte...
Es geht um einen Computer im netzlauifwerk den ich habe.
Mit dem folgendem code kann ich auslesen welches laufwerk zum Beispiel zu dem Laufwerksbuchstaben
s:
gehört.
Wie kann ich das am einfachsten und am schönsten auslesen welcher Laufwerksbuchstaben zu einem Laufwerk gehört ?
Also ich gebe das Laufwerk an und bekommen den Laufwerksbuchstaben zum Beispiel i:
Würde mich sehr über einen tipp freuen.Vielen dank
Option Explicit
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
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
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 Declare Function GetLogicalDrives& Lib "kernel32" ()
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2
Sub Laufwerke()
Dim a As Long
Dim L As Long
Dim i As Integer
On Error Resume Next
i = 0
L = GetLogicalDrives
For a = 97 To 123
If L And 2 ^ (a - 97) Then
Cells(i, 1).Value = Chr(a - 32) & ":"
i = i + 1
End If
Next
Call letter_to
End Sub
Public Function LetterToUNC(DriveLetter As String) As String
Dim hEnum As Long, NetInfo(1023) As NETRESOURCE
Dim entries As Long, nStatus As Long, LocalName As String, UNCName As String
Dim i As Long, r As Long
' Begin the enumeration
nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0&, ByVal 0&, hEnum)
LetterToUNC = ""
'Check for success from open enum
If ((nStatus = 0) And (hEnum 0)) Then
entries = 1024 ' Set number of entries
' Enumerate the resource
nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), _
CLng(Len(NetInfo(0))) * 1024)
' Check for success
If nStatus = 0 Then
For i = 0 To entries - 1
' Get the local name
LocalName = ""
If NetInfo(i).lpLocalName 0 Then
LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
End If
' Strip null character from end
If Len(LocalName) 0 Then LocalName = Left(LocalName, (Len(LocalName) - 1))
If UCase$(LocalName) = UCase$(DriveLetter) Then
' Get the remote name
UNCName = ""
If NetInfo(i).lpRemoteName 0 Then
UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) + 1)
r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
End If
' Strip null character from end
If Len(UNCName) 0 Then UNCName = Left(UNCName, (Len(UNCName) - 1))
LetterToUNC = UNCName ' Return the UNC path to drive
Exit For ' Exit the loop
End If
Next i
End If
End If
' End enumeration
WNetCloseEnum hEnum
End Function
Sub letter_to()
Dim n As String
Dim i As Long
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
n = LetterToUNC(Range("A" & i).Value)
Cells(i, 2).Value = n
Next i
End Sub