2
www.ChF-Online.de  

UNC-Pfad eines ausgewählten Verzeichnisses

   Neuigkeiten
   API-Aufrufe in VBA
 Belieb. Datei öffnen
 CommonDialog-Fehler
 Dateidatum lesen & setzen
 rel. Dateipfad korrigieren
 Flex. Öffnen-Dialog
 Flex. Speichern-Dialog
 Kurze Unterbrechung
 Pfade und Verzeichnisse
 Spracheinstellung
 TreeView löschen
 Verzeichnisauswahl
aktiv aktiv Verzeichnisauswahl /UNC
   VBA2HTML
   Word
   Word-VBA
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
Einschränkungen unter (Word97)Getestet unter Word2000Getestet unter Win2000  
Makro/Datei speichern
Print

Mit den unter  Verzeichnisauswahl genannten APIs lässt sich der Name eines ausgewählten Verzeichnisses ermitteln und weiterverwenden.
Bei Netzwerkverzeichnissen, die einem Laufwerkbuchstaben zugewiesen wurden, wird dabei auch der verwendete Laufwerksbuchstabe zurückgegeben.
Zur Umwandlung des Laufwerksbuchstabes in den UNC-Pfad stehen weitere APIs zur Verfügung. Diese durchlaufen alle Netzressourcen und ermitteln den zugehörigen Netwerkpfad.

Der ausgewählte Verzeichnisname wird zur Ermittlung des UNC-Pfades an die Funktion LetterToUNC() weitergereich, in der Netzwerkpfad ermittelt wird.
Vorher muss der Verzeichnisname noch vom Laufwerksbuchstaben abgetrennt werden, da die Funktion nur diesen Buchstaben als Parameter erwartet.
Der Aufruf kann folgendermaîen aussehen:

Sub UNCOrdnerauswahl() 
Dim sOrdner, sUNCOrdner As String 
sOrdner = BrowseForFolder("Bitte Ordner auswählen...")
' LW-Mappingnamen ermitteln und auflösen 
sUNCOrdner = LetterToUNC(Left(sOrdner, 2))
sOrdner = Right(sOrdner, Len(sOrdner) - 2)
MsgBox sUNCOrdner & sOrdner, , sOrdner
End Sub 

Wird direkt ein Netzwerkverzeichnis ausgewählt, muss dies vorher geprüft werden, da z.B. Windows 2000 ansonsten den Pfad aus dem Ordner Netzwerkumgebung zurückliefert.

Function LetterToUNC(DriveLetter As String) As String 
Dim hEnum As Long 
Dim NetInfo(1023) As NETRESOURCE
Dim entries As Long 
Dim nStatus As Long 
Dim LocalName As String 
Dim UNCName As String 
Dim i As Long 
Dim r As Long 
' Begin the enumeration 
nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, _
  0&, ByVal 0&, hEnum)
LetterToUNC = DriveLetter
'Check for success from open enum 
If ((nStatus = 0) And (hEnum <> 0)) Then 
  ' Set number of entries 
  entries = 1024
  ' 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))
        End If 
        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))
            End If 
            ' Return the UNC path to drive 
            'added the [] to seperate on printout only 
            LetterToUNC = UNCName
            ' Exit the loop 
            Exit For 
        End If 
    Next i
    End If 
End If 
' End enumeration 
nStatus = WNetCloseEnum(hEnum)
End Function

 Besucher: 3 online  |  28 heute  |  2628 diesen Monat  |  1593780 insgesamt | Seitenaufrufe: 72   Letzte Änderung: 24.06.2006 © 2001-14 Christian Freßdorf
  Der Anfang der Weisheit ist Verwunderung.
Aristoteles
 powered by phpCMS and PAX