VBA Tipp: UNC-Pfad ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Problem

Ich möchte aus dem Laufwerksbuchstaben eines Netzlaufwerks den UNC-Pfad ermitteln, also den Pfad in der Schreibweise \\Rechnername\Freigabename\ .

Lösung

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

Web-Links