Beispiel:

Option Explicit
 
Private Const NERR_SUCCESS          As Long = 0&
Private Const MAX_PREFERRED_LENGTH  As Long = -1
Private Const RESOURCETYPE_ANY      As Long = &H0
Private Const RESOURCE_CONNECTED    As Long = &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 Sub GetNetResources(ctrLB As VB.ListBox)
  '// -----------------------------------------------------
  '// Funktion:  | Ermittelt alle aktuellen
  '//            | Netzverbindungen und füllt eine Listbox
  '// -----------------------------------------------------
  '// Parameter: | ctrLB = Verweis auf eine Listbox
  '// -----------------------------------------------------
  '// Rückgabe:  | -
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  Dim uaNetRes()  As NETRESOURCE
  Dim lEnum       As Long
  Dim lBuffSize   As Long
  Dim lStructSize As Long
  Dim lEntries    As Long
  Dim lSuccess    As Long
  Dim lCount      As Long
  Dim sLocalName  As String
  Dim sUncName    As String
  ' Listbox leeren
  ctrLB.Clear
  ' Ein Enumerations-Handle für WNetEnumResource ermitteln
  lSuccess = WNetOpenEnum(RESOURCE_CONNECTED, _
      RESOURCETYPE_ANY, _
      0&, _
      ByVal 0&, _
      lEnum)
  ' Prüfen, ob es ein Handle gibt und kein Fehler
  ' aufgetreten ist
  If lSuccess = NERR_SUCCESS And lEnum <> 0 Then
    ' lEntries initialisieren und Array dimensionieren
    lEntries = 1024
    ReDim uaNetRes(0 To lEntries - 1) As NETRESOURCE
    ' Buffergröße ermitteln
    lStructSize = LenB(uaNetRes(0))
    lBuffSize = 1024& * lStructSize
    ' Funktion WNetEnumResource aufrufen
    lSuccess = WNetEnumResource(lEnum, _
        lEntries, _
        uaNetRes(0), _
        lBuffSize)
    If lSuccess = 0 Then
      For lCount = 0 To lEntries - 1
        sLocalName = vbNullString
        sUncName = vbNullString
        ' Laufwerksbuchstaben ermitteln
        If uaNetRes(lCount).lpLocalName <> 0 Then
          sLocalName = _
              GetStrFromPtrA(uaNetRes(lCount).lpLocalName)
          sLocalName = TrimNull(sLocalName)
        End If
        ' UNC-Pfad ermitteln
        If uaNetRes(lCount).lpRemoteName <> 0 Then
          sUncName = _
              GetStrFromPtrA(uaNetRes(lCount).lpRemoteName)
          sUncName = TrimNull(sUncName)
        End If
        ' Ergebnisse in die Listbox eintragen
        ctrLB.AddItem sLocalName & vbTab & sUncName
      Next lCount  ' For lCount = 0
    Else
      ctrLB.AddItem "Keine Netzlaufwerke gefunden!"
    End If  ' lSuccess = 0 (WNetEnumResource)
  End If  ' lSuccess = 0 (WNetOpenEnum)
  Call WNetCloseEnum(lEnum)
 
End Sub
 
Public Function GetStrFromPtrA( _
                ByVal lpszA As Long) As String
 
  GetStrFromPtrA = String$(lstrlen(ByVal lpszA), 0)
  Call lstrcpy(ByVal GetStrFromPtrA, ByVal lpszA)
 
End Function
 
Private Function TrimNull(sItem As String)
 
  Dim iPos As Integer
  iPos = InStr(sItem, Chr$(0))
  If iPos Then
    TrimNull = Left$(sItem, iPos - 1)
  Else: TrimNull = sItem
  End If
 
End Function
 
Public Function GetUncPath( _
                ByVal sLocalDrive As String) _
                As String
  '// -----------------------------------------------------
  '// Funktion:  | Ermittelt den UNC-Pfad zu einem
  '//            | Laufwerksbuchstaben. Alternative
  '//            | Anwendung der Methode GetNetResources
  '// -----------------------------------------------------
  '// Parameter: | sLocalDrive = lokales Laufwerk
  '// -----------------------------------------------------
  '// Rückgabe:  | -
  '// -----------------------------------------------------
  '// Beispiel:
  '// Debug.Print GetUncPath("K:")
  '// -----------------------------------------------------
  Dim uaNetRes()  As NETRESOURCE
  Dim lStructSize As Long
  Dim lBuffSize   As Long
  Dim lEntries    As Long
  Dim lSuccess    As Long
  Dim lCount      As Long
  Dim lEnum       As Long
  Dim sLocalName  As String
  Dim sUncName    As String
  ' Ein Enumerations-Handle für WNetEnumResource ermitteln
  lSuccess = WNetOpenEnum(RESOURCE_CONNECTED, _
      RESOURCETYPE_ANY, _
      0&, _
      ByVal 0&, _
      lEnum)
  ' Prüfen, ob es ein Handle gibt und kein
  ' Fehler aufgetreten ist
  If lSuccess = NERR_SUCCESS And lEnum <> 0 Then
    ' lEntries initialisieren und Array dimensionieren
    lEntries = 1024
    ReDim uaNetRes(0 To lEntries - 1) As NETRESOURCE
    ' Buffergröße ermitteln
    lStructSize = LenB(uaNetRes(0))
    lBuffSize = 1024& * lStructSize
    ' Funktion WNetEnumResource aufrufen
    lSuccess = WNetEnumResource(lEnum, _
        lEntries, _
        uaNetRes(0), _
        lBuffSize)
    If lSuccess = 0 Then
      For lCount = 0 To lEntries - 1
        sLocalName = vbNullString
        sUncName = vbNullString
        If uaNetRes(lCount).lpLocalName <> 0 And _
            uaNetRes(lCount).lpRemoteName <> 0 Then
          ' Laufwerksbuchstaben ermitteln
          sLocalName = _
              GetStrFromPtrA(uaNetRes(lCount).lpLocalName)
          ' Ergebnis vergleichen
          If Left$(sLocalDrive, 1) = _
              Left$(sLocalName, 1) Then
            ' Bei Erfolg den UNC-Pfad ermitteln
            sUncName = _
                GetStrFromPtrA( _
                uaNetRes(lCount).lpRemoteName)
            GetUncPath = TrimNull(sUncName)
            Call WNetCloseEnum(lEnum)
            Exit Function
          End If  ' Left$(sLocalDrive
        End If  ' uaNetRes(lCount)
      Next lCount  ' For lCount = 0
    Else
      GetUncPath = vbNullString
    End If  ' lSuccess = 0 (WNetEnumResource)
  End If  ' lSuccess = 0 (WNetOpenEnum)
  Call WNetCloseEnum(lEnum)
 
End Function