Option Explicit
Option Private Module
' ---------------------------------------------------------
' Funktion GetUNCPath
' Zeigt den UNC-Pfad eines Laufwerkes
' Eingestellt von: Andre Schau
' Datum: 2011-09-10
' Kommentar:
' Parameter: strDrive in Form "X:"
' Rückgabe: UNC-Pfad, bei lokalem Laufwerk Laufwerksbuchstabe
' weitere benoetigte Programme und Funktionen
' API-Funktion: WNetGetConnection
' Aufruf:
' Sub Call_GetUNCPath()
' MsgBox "Der UNC-Pfad vom Netzlaufwerk X: lautet: " & GetUNCPath("X:")
' End Sub
' ---------------------------------------------------------
 
Private Declare Function WNetGetConnection Lib _
   "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName _
   As String, ByVal lpszRemoteName As String, _
   cbRemoteName As Long) As Long
   
'Aufruf
Sub Call_GetUNCPath()
    MsgBox "Der UNC-Pfad vom Netzlaufwerk X: lautet: " & GetUNCPath("X:")
End Sub

Function GetUNCPath(ByVal strDrive As String) As String
'Parameter: Laufwerksbuchstabe in Form "L:"
'keine Fehlerbehandlung!
'Variablendeklarationen
'String
Dim strUNCPath$, strResult$
'Long
Dim lRet&
'Rueckgabewert zuweisen
GetUNCPath = strDrive
'Leerstring (Nullzeichen) fuer UNCPath erzeugen
strUNCPath = String(260, 0)
'Abfrage des UNC-Path,
'Rueckgabe aus WNetGetConnection bei UNC-Path = 0
'1200 bei nicht vorhandenem LW, 2250 bei lokalem LW
'(getestet unter W7-64)
'API-Parameter: Laufwerk, Leerstring, Laenge des Leerstring,
lRet = WNetGetConnection(strDrive, strUNCPath, 260)
'Wenn Rueckgabe = 0 dann
If lRet = 0& Then
  'Nullzeichen in strUNCPath entfernen
  strResult = Left$(strUNCPath, InStr(strUNCPath, vbNullChar) - 1)
  'zurueckgegebener String sollte Zeichen enthalten
  'Wenn
  If Len(strResult) > 0 Then
    'Rueckgabewert zuweisen
    GetUNCPath = strResult
  End If
'Ende Wenn Rueckgabe = 0 dann
End If
End Function