Herbers Excel-Forum - das Archiv
Ziel einer Verknüpfung zu einem Ordner finden
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