Ziel einer Verknüpfung zu einem Ordner finden

Informationen und Beispiele zu den hier genannten Dialog-Elementen:

Ziel einer Verknüpfung zu einem Ordner finden von Stefan vom 23.03.2005 12:01:57

AW: Ziel einer Verknüpfung zu einem Ordner finden - von Tobias Marx am 23.03.2005 14:34:58
So müsste es gehen - von Frank Domke am 23.03.2005 15:01:02
- AW: So müsste es gehen - von Stefan am 23.03.2005 16:01:26

Betrifft: Ziel einer Verknüpfung zu einem Ordner finden von: Stefan
Geschrieben am: 23.03.2005 12:01:57

In einem Ordner sind mehrere Unterordner, die ich per Makro durchsuchen will,
in etwa mit folgendem Code:

pfad = ThisWorkbook.Path & "\"
ordner = Dir(pfad, vbDirectory)
Do While ordner <> ""
If GetAttr(pfad & ordner) And vbDirectory Then
MsgBox ordner
End If
ordner = Dir()
Loop

In dem Ordner sind aber auch einige Verknüpfungen auf andere Ordner enthalten, die ich auch durchsuchen muss. Diese werden aber nicht als Ordner erkannt, sondern als .lnk-Datei. Wie bekomme ich das Ziel dieser Verknüpfungen heraus?
Oder gibt es einen anderen Weg, auch die Zielverzeichnisse der Verknüpfungen zu durchsuchen?

Betrifft: AW: Ziel einer Verknüpfung zu einem Ordner finden von: Tobias Marx
Geschrieben am: 23.03.2005 14:34:58

Servus!

Soweit ich weiss, wirst du das nicht hinbekommen, weil solche Verknuepfungen unter windows einfach *.lnk-Dateien sind - obs dir passt oder nicht. Die Dateien werden immer als solche behandelt, ausser ueber den Windows-Explorer (selbst ueber andere aeltere Dateimananger werden sie nru als Datei erkannt).
Wenn du das irgendwie schaffen willst, musst du die Eigenschaften der *.lnk-Datei auslesen (frag mich ned wie das geht), in denen steht dann auch der Ordner, auf den die Datei verweist. So muesste es dann ansich gehen.

Gruss

Tobias

Betrifft: So müsste es gehen von: Frank Domke
Geschrieben am: 23.03.2005 15:01:02

Hallo Stefan,
versuche es mal so:


Sub Stefan()
    ' Verweis auf "Windows Script Host Object Model" setzen!
    Dim Shell As WshShell
    Dim Shortcut As WshShortcut
    
    Set Shell = New WshShell
    Pfad = ThisWorkbook.Path & "\"
    ordner = Dir(Pfad, vbNormal)
    Do While ordner <> ""
        If GetAttr(Pfad & ordner) And vbDirectory Then
            MsgBox ordner
        ElseIf Right(ordner, 4) = ".lnk" Then
            ' Link auflösen
            Set Shortcut = Shell.CreateShortcut(Pfad & ordner)
            If GetAttr(Shortcut.TargetPath) And vbDirectory Then
                MsgBox Shortcut.TargetPath
            End If
            Set Shortcut = Nothing
        End If
        ordner = Dir()
    Loop
    Set Shell = Nothing
End Sub

Viel Erfolg
Frank.

Betrifft: AW: So müsste es gehen von: Stefan
Geschrieben am: 23.03.2005 16:01:26

Vielen Dank für deine Antwort, so scheint es zu gehen.

Ich habe inzwischen etwas ähnliches gefunden (benutzt wahrscheinlich dieselbe Funktionalität wie dein Makro):


Private Function GetShortcutTarget(strShortcut As String) As String
    Dim wshell As Object
    Set wshell = CreateObject("wscript.Shell")
    On Error Resume Next ' skip if shortcut does not exist
        GetShortcutTarget = wshell.CreateShortcut(strShortcut).TargetPath
    On Error GoTo 0
End Function