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.
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
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
- Sub Ordner_auslesen()
- On Error GoTo ENDE
- 'Hauptordner auflisten
- Dim FileSystem As Object
- Dim Unterordner
- Dim Datei
- Dim Zeile As Long
- Dim Spalte As Long
- Dim Ordner
- Set Ws = Tabelle003
- Set FileSystem = CreateObject("Scripting.FileSystemObject")
- Spalte = 5
- Zeile = 14
- 'Alter Inhalt l?schen
- Ws.Range("E15:E1000").ClearContents
- 'Aktualisierung ausschalten
- With Application
- .ScreenUpdating = False
- .Calculation = xlCalculationManual
- .EnableEvents = False
- End With
- ' Ordner ausw?hlen
- 'Ordner = GetFolder()
- ' Festen Ordner definieren
- Ordner = Ws.Cells(10, 5) 'Ordnerpfad einlesen
- If FileSystem.FolderExists(Ordner) Then
- Set Ordner = FileSystem.GetFolder(Ordner)
- For Each Datei In Ordner.Files
- Zeile = Zeile + 1
- ' Dateiname mit Pfad wird aufgelistet
- ' Ws.Cells(Zeile, Spalte).Value = Datei
- ' Nur der Dateiname wird aufgelistet
- Ws.Cells(Zeile, Spalte).Value = Datei.Name
- 'Ws.Cells(Zeile, Spalte - 2).Value = Datei.DateCreated
- 'Ws.Cells(Zeile, Spalte - 1).Value = Datei.DateLastModified
- 'Ws.Cells(Zeile, Spalte + 1).Value = Datei
- ' Wenn mit Hyperlink zur Datei dann
- Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Ordner
- Next
- ListOrdner Ordner, Zeile, 5 'Versatz f?r die Auflistung der Unterordner
- End If
- 'Aktualisierung einschalten
- With Application
- .ScreenUpdating = True
- .Calculation = xlCalculationAutomatic
- .EnableEvents = True
- End With
- Range("A1").Select
- ENDE:
- End Sub
- Sub ListOrdner(Ordner, Zeile, Spalte)
- 'Unterordner auflisten
- Dim FileSystem As Object
- Dim Unterordner
- Dim Datei
- Set Ws = Tabelle003
- Set FileSystem = CreateObject("Scripting.FileSystemObject")
- If FileSystem.FolderExists(Ordner) Then
- Set Ordner = FileSystem.GetFolder(Ordner)
- For Each Unterordner In Ordner.subfolders
- Zeile = Zeile + 1
- With Ws.Cells(Zeile, Spalte)
- ' Ordner mit Pfad angeben
- ' .Value = Unterordner
- ' nur Ordnernamen angeben
- .Value = Unterordner.Name
- ' Zellformatierung
- .Font.Bold = True
- .Font.Underline = False
- .Font.Color = RGB(0, 0, 0)
- '.Interior.Color = RGB(255, 255, 0)
- End With
- For Each Datei In Unterordner.Files
- Zeile = Zeile + 1
- ' Dateiname mit Pfad wird aufgelistet
- ' Ws.Cells(Zeile, Spalte).Value = Datei
- ' Nur der Dateiname wird aufgelistet
- Ws.Cells(Zeile, Spalte).Value = Datei.Name
- 'Ws.Cells(Zeile, Spalte - 2).Value = Datei.DateCreated
- 'Ws.Cells(Zeile, Spalte - 1).Value = Datei.DateLastModified
- 'Ws.Cells(Zeile, Spalte + 1).Value = Datei
- ' Wenn mit Hyperlink zur Datei dann
- Ws.Hyperlinks.Add Ws.Cells(Zeile, Spalte), Datei
- Next
- ListOrdner Unterordner, Zeile, Spalte
- Next
- End If
- End Sub
- Private Function GetFolder() As String
- 'Funktion um den Ordner auszuw?hlen
- Dim objShell As Object
- Dim strPath As String
- Set objShell = CreateObject("Shell.Application")
- Set varFolder = objShell.BrowseForFolder(0, "Folder", &H4000, 17)
- If varFolder Is Nothing Then
- Set varFolder = Nothing
- Set objShell = Nothing
- Exit Function
- End If
- GetFolder = varFolder.Self.Path
- Set objShell = Nothing
- 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“ ()