Verknüpfung (.lnk) in Tabelle einlesen und automatisch verlinken

  • Excel

Es gibt 10 Antworten in diesem Thema. Der letzte Beitrag () ist von Marco123.

    Verknüpfung (.lnk) in Tabelle einlesen und automatisch verlinken

    Hallo Forum,

    ich versuche mich schon längerem an folgender Aufgabe:

    - Alle SubOrdner und Dateien aus einem Verzeichnis in eine Excel-Tabelle einlesen und automatisch verlinken

    Bei meiner Suche in den unendlichen Weiten des Internets bin ich auch auf einen sehr guten VBA-Code gestoßen, wobei ich zugeben muss, dass ich nicht mehr genau weiß wo ich ihn gefunden habe.
    Diesen Code hab ich entsprechend am meine Bedürfnisse angepasst und er macht auch genau das was er soll.
    Sämtliche Subordner werden aufgelistet und alle darin enthaltenen Dateien (Excel, Word, PP, etc) werden automatisch verlinkt.

    Soweit so gut.

    Eine kleine Zusatzfunktion würde das ganze jedoch noch abrunden:
    - eine funktionierende automatische Verlinkung einer Verknüpfung (.lnk)

    Alle in den Ordnern vorhandene Verknüpfung (.lnk) werden eingelesen, aufgelistet und auch mit einem Hyperlink versehen, aber dieser lässt sich dann nicht nutzen.

    Visual Basic-Quellcode

    1. Sub Ordner_auslesen()
    2. On Error GoTo ENDE
    3. 'Hauptordner auflisten
    4. Dim FileSystem As Object
    5. Dim Unterordner
    6. Dim Datei
    7. Dim Zeile As Long
    8. Dim Spalte As Long
    9. Dim Ordner
    10. Set Ws = Tabelle003
    11. Set FileSystem = CreateObject("Scripting.FileSystemObject")
    12. Spalte = 5
    13. Zeile = 14
    15. 'Alter Inhalt l?schen
    16. Ws.Range("E15:E1000").ClearContents
    17. 'Aktualisierung ausschalten
    18. With Application
    19. .ScreenUpdating = False
    20. .Calculation = xlCalculationManual
    21. .EnableEvents = False
    22. End With
    24. ' Ordner ausw?hlen
    25. 'Ordner = GetFolder()
    27. ' Festen Ordner definieren
    28. Ordner = Ws.Cells(10, 5) 'Ordnerpfad einlesen
    30. If FileSystem.FolderExists(Ordner) Then
    31. Set Ordner = FileSystem.GetFolder(Ordner)
    33. For Each Datei In Ordner.Files
    34. Zeile = Zeile + 1
    36. ' Dateiname mit Pfad wird aufgelistet
    37. ' Ws.Cells(Zeile, Spalte).Value = Datei
    38. ' Nur der Dateiname wird aufgelistet
    39. Ws.Cells(Zeile, Spalte).Value = Datei.Name
    40. 'Ws.Cells(Zeile, Spalte - 2).Value = Datei.DateCreated
    41. 'Ws.Cells(Zeile, Spalte - 1).Value = Datei.DateLastModified
    42. 'Ws.Cells(Zeile, Spalte + 1).Value = Datei
    44. ' Wenn mit Hyperlink zur Datei dann
    45. Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Ordner
    47. Next
    49. ListOrdner Ordner, Zeile, 5 'Versatz f?r die Auflistung der Unterordner
    51. End If
    52. 'Aktualisierung einschalten
    53. With Application
    54. .ScreenUpdating = True
    55. .Calculation = xlCalculationAutomatic
    56. .EnableEvents = True
    57. End With
    59. Range("A1").Select
    61. ENDE:
    62. End Sub
    64. Sub ListOrdner(Ordner, Zeile, Spalte)
    65. 'Unterordner auflisten
    66. Dim FileSystem As Object
    67. Dim Unterordner
    68. Dim Datei
    69. Set Ws = Tabelle003
    70. Set FileSystem = CreateObject("Scripting.FileSystemObject")
    71. If FileSystem.FolderExists(Ordner) Then
    72. Set Ordner = FileSystem.GetFolder(Ordner)
    73. For Each Unterordner In Ordner.subfolders
    75. Zeile = Zeile + 1
    77. With Ws.Cells(Zeile, Spalte)
    78. ' Ordner mit Pfad angeben
    79. ' .Value = Unterordner
    80. ' nur Ordnernamen angeben
    81. .Value = Unterordner.Name
    82. ' Zellformatierung
    83. .Font.Bold = True
    84. .Font.Underline = False
    85. .Font.Color = RGB(0, 0, 0)
    86. '.Interior.Color = RGB(255, 255, 0)
    87. End With
    89. For Each Datei In Unterordner.Files
    90. Zeile = Zeile + 1
    91. ' Dateiname mit Pfad wird aufgelistet
    92. ' Ws.Cells(Zeile, Spalte).Value = Datei
    93. ' Nur der Dateiname wird aufgelistet
    94. Ws.Cells(Zeile, Spalte).Value = Datei.Name
    95. 'Ws.Cells(Zeile, Spalte - 2).Value = Datei.DateCreated
    96. 'Ws.Cells(Zeile, Spalte - 1).Value = Datei.DateLastModified
    97. 'Ws.Cells(Zeile, Spalte + 1).Value = Datei
    99. ' Wenn mit Hyperlink zur Datei dann
    100. Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Datei
    101. Next
    103. ListOrdner Unterordner, Zeile, Spalte
    104. Next
    105. End If
    106. End Sub
    108. Private Function GetFolder() As String
    109. 'Funktion um den Ordner auszuw?hlen
    110. Dim objShell As Object
    111. Dim strPath As String
    112. Set objShell = CreateObject("Shell.Application")
    113. Set varFolder = objShell.BrowseForFolder(0, "Folder", &H4000, 17)
    114. If varFolder Is Nothing Then
    115. Set varFolder = Nothing
    116. Set objShell = Nothing
    117. Exit Function
    118. End If
    119. GetFolder = varFolder.Self.Path
    120. Set objShell = Nothing
    122. End Function



    Hat sich evtl. einer von Euch schonmal mit einer ähnlichen Herausforderung rumgeplagt?Falls ja, was war die Lösung des ganzen?
    Kann man überhaupt einen funktionierenden Hyperlink auf eine Verknüpfung setzen?

    Ich bin gespannt auf Eure Rücklmeldungen.Vielen Dank im Voraus :)

    CodeTags korrigiert ~VaporiZed

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „VaporiZed“ ()

    Hast Du mal die Adresse überprüft? Was gibt er denn aus für 'Ordner' bzw. in Deiner zweiten Sub für 'Datei'?

    Visual Basic-Quellcode

    1. Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Ordner


    Visual Basic-Quellcode

    1. Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Datei


    die Farbe Rot ist der Moderation vorbehalten und wurde ersetzt ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Hallo cry.baby,

    der Code im Sub Ordner_auslesen (Zeile 45) hat eigentlich keine Auswirkungen.
    Auch wenn ich den Part rausnehme, läuft alles wie gewohnt.
    Ist wohl ein Überbleibsel vor Originalcode.

    Der Code im Sub ListOrdner (Zeile 100) beeinflusst, worauf verlinkt wird
    - Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Datei bewirkt eine Verlinkung auf direkt auf die Datei im Unterordner
    - Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Ordner bewirkt eine Verlinkung auf den Ordner in dem sich der Unterordner befindet

    Wie gesagt, die automatischen Verlinkungen laufen eigentlich einwandfrei, bis halt auf das Thema .lnk.
    Ich befürchte jedoch, dass ein Hyperlink auf eine Verknüpfung nicht möglich zu sein scheint.
    Hab es grade nochmal mit der Formel =Hyperlink() versucht.
    Hierbei kommt es zum gleichen Problem:
    - Hyperlink wird erzeugt
    - MS Office fragt, ob ich wirklich öffnen möchte
    - nach Bestätigung blauer Ladekreis und das war es dann

    Evtl. übersehe ich auch etwas ganz einfaches.
    Wenn mich also jemand wieder auf Spur bringen kann, darf er/sie das gerne machen :)

    CodeTags gesetzt ~VaporiZed

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Hi cry.baby,

    Sämtliche innerhalb des auszulesenden Ordners abgelegte Dateien werden eingelesen, aufgelistet und erhalten einen Hyperlink.
    Der o.g. Code setzt eigenständig die jeweiligen Hyperlinks, halt automatisch ohne manuellen Aufwand.

    Was mit einzelnen Dateien (xlsx., docx, .ppt, etc.) wunderbar funktioniert soll nach Möglichkeit auch mit Verknüpfungen (.lnk) geschehen, welche in dem ausgelesenen Ordner vorhanden sind.

    Es sollen also auch Verlinkungen verlinkt werden.

    Ich verstehe Deinen Vorschlag, muss jedoch zugeben das ich anscheinend nicht in der Lage bin, diesen umzusetzen.
    Hab jetzt mit meinem Anfängerwissen einige Male probiert umzusetzen, scheitere jedoch jedes Mal.

    Um mein Unwissen irgendwie mit Laub zu bedecken hab ich parallel noch nach einem Plan B gesucht … und hab zumindest einen Ansatz gefunden:

    Mit dem Code lässt sich das Ziel einen Verknüpfung auslesen:

    Visual Basic-Quellcode

    1. Public Sub Verknuepfungen_auslesen()
    3. Dim objShell As Object
    4. Dim Unterordner As Object
    5. Dim Datei As Object
    6. Dim Link As Object
    8. Set objShell = CreateObject("Shell.Application")
    10. Set Unterordner = objShell.Namespace("hier Pfad einfügen")
    12. For Each Datei In Unterordner.items
    14. If Datei.IsLink Then
    16. Set Link = Datei.GetLink
    18. Call MsgBox(Link.Path)
    20. End If
    21. Next
    23. Set Link = Nothing
    24. Set Unterordner = Nothing
    25. Set objShell = Nothing
    27. End Sub



    Mein Gedanke war halt: Wenn ich was auslesen kann, kann ich doch auch benutzen.
    Aber, was soll ich sagen, dann stellte mir meine Unfähigkeit wieder ein Bein.
    Ich habs nicht hinbekommen, den Code in meinen bestehenden Code (s.o.) einzubauen.

    Was meinst Du?
    Wie ließe sich sowas miteinander verbinden?

    Korrekte Code-Tags gesetzt ~ EaranMaleasi

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „EaranMaleasi“ ()

    Es geht sogar noch einfacher. Wenn Du bei der Adressierung Deines Hyperlinks anstelle dem Datei-Namen einfach ShortPath verwendest, funktioniert es auch (Code Zeil 100):

    Visual Basic-Quellcode

    1. Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Datei.ShortPath


    Die Code-Zeile 94 kannst Du Dir übrigens sparen:

    Visual Basic-Quellcode

    1. Ws.Cells(Zeile, Spalte).Value = Datei.Name

    Sorry für meine verspätete Rückmeldung.
    Habe Deinen Vorschlag umgesetzt und musste leider erkennen, musste aber leider erkennen, dass das Ergebnis anscheinend das gleiche ist.

    Dennoch habe ich die Aufgabe auf andere Art lösen können, wenn diese auch etwas mehr der Vorgehensweise "von hinten durch die Brust in Auge" gleicht.
    Hier mein Lösungsweg:
    1. Entfernung der Code-Zeile 100 (Erstellung Hyperlink)
    2. Datenübernahme in ListBox (Dateiname, Pfad)
    3. Übertrag Auswahl ListBox in fixe Zellen (Dateiname = A1, Pfad = B1)
    4. Öffnen des Pfads (Zelle B1) mit folgendem Code:

    Visual Basic-Quellcode

    1. Sub Öffnen()
    2. On Error GoTo ENDE
    3. Dim Pfad As String
    4. Pfad = Tabelle003.Range("B1")
    5. Shell "explorer.exe /e, " & Pfad, vbMaximizedFocus
    6. ENDE:
    7. End Sub



    Hätte man sicherlich eleganter lösen können, aber es funktioniert bisher tadellos.
    Alle Dateien und Verlinkungen innerhalb des ausgelesenen Ordners lassen sich nun ohne weiteres öffnen.

    Besten Dank für Deine Hilfe.
    Auch wenn ich letztendlich einen anderen Weg gegangen bin, hast Du mir die nötigen Impulse gegeben.

    Korrekte Code-Tags gesetzt ~ EaranMaleasi

    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „EaranMaleasi“ ()

    @Marco123 Nimm dir die Links die @VaporiZed und ich dir geschickt haben zu Herzen. Korrektes Auswählen der Code-Tags (entweder über die Buttons im Editor, oder händisches Einfügen des korrekten Tags) erhöht die Lesbarkeit des Codes für alle Beteiligten. Es sollte nicht unsere Aufgabe sein, hinter jedem einzelnen User aufräumen zu müssen.

    @EaranMaleasi Vielen Dank für den Hinweis.
    Ich hab die Korrekturen und die "Einfärbungen" gesehen und mich schon gefragt wie das geht.
    Hab nun auch die Verlinkung erkannt, mir die nötigen Infos besorgt und anhand eines Beispiels getestet => funktioniert.

    Ab nun muss man hoffentlich nicht mehr hinter mir aufräumen :)

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Marco123“ ()

Facebook
Telefonspende