---

Hallo Ihr Freaks! (;
Ich kenn mich nicht aus, ich möcht dieses:

Option Explicit
Sub link_me2()
Dim i&, x$, y$
i = 1
x = Dir("C:\Eigene Dateien\Eigene Bilder\*")
y = "C:\Eigene Dateien\Eigene Bilder\"
Do While x <> ""
With Sheets(1)
  .Cells(i, 1) = x
  .Hyperlinks.Add Anchor:=Cells(i, 1), Address:=y & x, TextToDisplay:=x
End With
i = i + 1
x = Dir
Loop
End Sub

script
so erweitern das nicht nur das eine Verzeichniss als Hyperlink erstellt wird, sondern ebenso die gesamten Unterverzeichnisse die sich in dem Dateipfad befinden.
Das ganze soll meinem Kollegen und mir als Inhaltsverzeichniss bei einem recht grossem Verzeichniss mit ca. 1000 dateien helfen die richtigen herauszufinden.
Schön wäre natürlich wenn jedes Verzeichniss mit nem Plus zeichen zum Aufklappen von Untereinträgen ist, so wie im Explorer auch. Aber das ist gar nicht so super wichtig, wichtiger wäre wenn jedes Verzeichniss das abgeklappert wird in einer Grösseren Schrift erscheint, so das klar ist - hier ist ein neuer info-ordner -

Wenn mir dabei jemand helfen kann bin ich DIR SUPER Mega dankbar!

Danke schon mal im Vorraus für die schnelle Hilfe!

mfg
Chris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ach, genau ich hab da evt. noch was wichtiges, die Dateien sind auf einem Intranet Server gespeichert, ich hatte dann vor die Pfadangabe noch so: \\laufwerksbuchstabe\pfad\ anzupassen, funktioniert das dann überhaupt? Oder hab ich dann gleich ein Problem wenn ich´s so mach?

Danke fürs lesen!
mfg
Chris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

verrate doch mal um welche Art von Files es sich handelt - vielleicht gehst du es ja sowieso zu kompliziert an...

Und für was soll das Inhaltsverzeichnis sein ? (Wenn du was wie im Explorer haben möchtest - warum nimmst du diesen nicht her ?) Sonst - wenn du es wirklich wie im Explorer haben willst - musst du mit TreeMenu arbeiten (siehe dazu auch hier).

------------------
Grüsse

Thomas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Chris,

ich habe vor einiger Zeit mal so ein Script aus dem Web gezogen.
Ist bei mir auf der Arbeit.

Wenn Du Interesse hast, schicke ich es Dir morgen.

------------------
Gruss Bernd

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Thomas und Bernd.

Danke für eure Antworten! die erste Antwort mit dem File Browser ist ja nicht schlecht. Nur soll die Anwendung nichts kosten und 2. würde mir eine Excel Lösung schon reichen. Nur fehlt mir die Fachkenntniss um das Script so zu ändern das die Überschriften/Ordner anders formatiert sind, oder ich dem entsprechende leichtere Navigation und Übersicht für die Kollegen hab.

Bernd ich würde mich freunen wenn mir die Datei bzw. Script schicken kannst.

Danke Dir im vorraus!

Mfg
Chris 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Dieses Scipt kann die kompletten Ordner lesen, allerdings nicht die Überschriften/Ordner Darstellen und verlinken.
Und die Pfade was dann raus kommen sind zwar Komplett angegeben, aber keine wirkliche Navigations-Hilfe..

Ich paste es mal mit hier rein vielleicht bringt´s jemanden andren dann was..

Sub Dateien_als_Hyperlink_listen()
' Listet alle Dateien als Hyperlink
Application.ScreenUpdating = False
    Dim myFSO As Object
    Dim myDrvList, myDrv, mySpace
    Dim Dateiform As String, myStr As String
    Dim geffile As String
    Dim i As Long, totFiles As Long, chkHype As Integer
    Dim oldStatus As Variant
    Set myFSO = CreateObject("Scripting.Filesystemobject")
    Set myDrvList = myFSO.drives
    Application.ScreenUpdating = True
    oldStatus = Application.StatusBar
    On Error GoTo myErrHandler
    Dateiform = "*.*"
    If Dateiform = "" Then
        Application.ScreenUpdating = True
        Exit Sub
        End If
                With Application.FileSearch
                      .LookIn = "\\Aufträge\neu\" '<------------------------------  Pfad anpassen
                    .SearchSubFolders = True 'True für Suche in allen Unterverzeichnissen!!
                    .Filename = Dateiform
                    If .Execute() > 0 Then
                        totFiles = .FoundFiles.Count
                        Application.StatusBar = "Total " & totFiles & " in " & mySpace & " gefunden "
                        For i = 1 To .FoundFiles.Count
                            geffile = .FoundFiles(i)
                            Cells([A65536].End(xlUp).Row + 1, 1) = geffile
                            ActiveSheet.Hyperlinks.Add Anchor:=Cells([A65536].End(xlUp).Row, 1), Address:=geffile _
                                , TextToDisplay:=geffile
                                Selection.Font.ColorIndex = 2
                        Next i
                    End If
                End With
         
ErrEntry:
    Application.StatusBar = oldStatus
    Application.ScreenUpdating = True
MyExit:
    Close #1
    Exit Sub
   
myErrHandler:
    Select Case Err
        Case 71
            myStr = myStr & "Datenträger nicht bereit"
    End Select
    Resume ErrEntry
End Sub

also Bernd ich warte auf Antwort..

mfg
Chris 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

mit_Pfad.bas.txt ohne_Pfad.bas.txt

Hi Chris,

hier mal die beiden Scripts,^ich hoffe Du kannst damit was anfangen.

------------------
Gruss Bernd

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd.

Danke Dir für die schnelle Antwort! Ich habe jetzt allerdings noch nicht so ein Inhaltsverzeichniss wie ich es haben möchte. Die sind jetzt alle in der Spalte nach rechts hin geordnet..
Bei mir sind es sehr viel Unterordner die dann auch einen Aussagekräftigen Namen haben, der soll in der Liste erscheinen, sozusagen als Schlagwort. Und das Schlagwort mit Link dann noch gross zu bekommen in einer abfallenden Liste ist so das Hauptziel was ich mit der Liste erreichen möchte. Die Liste wird dann alle 5 Tage sowas aktualisiert, und das heist es muss automatisch die Ordnung geben. (es sollen alle Dateien gefunden werden)

Ich könnte jetzt zwar die Liste so wie ich sie ausgegeben bekomme ordnen, das dann allerdings alle 5 Tage zu machen ist doch schon recht heftig.

Vielleicht weis noch irgendeiner eine super Lösung dafür? Oder Bernd du vielleicht auch?

Danke für jede Hilfe!
mfg
Chris 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

hier mal als grober Ansatz, ich hoffe der Code ist klar genug zum Selbstanpassen,
um das richtige Explorerfeeling unter Excel [heavy] zu bekommen;-)

HTH Nancy
--

Code:

---

Sub Explorer_zum_Selbstbausatz()
    Dim fso As Object  '''New FileSystemObject
    Set fso = CreateObject("Scripting.Filesystemobject")
    Dim f As Object, i&
    Columns("A:E").ClearContents
    With Application.FileSearch
        .LookIn = "d:\cad\"
        .SearchSubFolders = True
        .Filename = "*.*"
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Set f = fso.GetFile(.FoundFiles(i))
                Cells(i + 1, 1) = f.ParentFolder
                Cells(i + 1, 3) = f.Type
                Cells(i + 1, 4) = f.Size
                Cells(i + 1, 5) = f.DateLastModified
                ActiveSheet.Hyperlinks.Add Cells(i + 1, 2), f.Path, , , f.Name
            Next
        End If
    End With
    Columns("A:E").AutoFit: [a1:e1].AutoFilter
    set fso=nothing
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Nancy.

Danke für die schnelle Antwort, die ist bestimmt selbst gebaut... (
Einfügen von Pfad klappt. (;
Wenn ich jetzt allerdings beim laufen die Fehlermeldung "fehler beim Kompilieren / Benutzerdefinierter Typ nicht definiert" bekomme, dann ist aus bei mir.

Wo ist denn der Fehler?

mfg
Chris, und schönen Feierabend!   

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

^
|
|
|
sorry sh.o., lag am Binding, ich habs mal reineditiert in den Code.

HTH, Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Morgen Nancy.

Bei mir Zuhause hat es wunderbar geklappt, hier bricht er nach 370 Dateien auf dem Server ab. Mit "Datei nicht gefunden".
Gibt es eine Möglichkeit diese Dateigruppen dann automatisch zu Gruppieren? Jeder Unterordner einzeln so das der Autofilter dann evt. auch noch funktioniert?

Aber zuerst mal frag ich mich warum das bei mir Zuhause funktioniert hat, und der hier komischerweise immer nach 370 Dateien abbricht.

Soll ja jetzt nicht in Arbeit ausarten... hahaha! 

Danke für die Hilfe.
mfg
Chris 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Nancy!
,oder wer sich noch damit auskennt!

Wenn du keine lust und zeit hast das zu machen, ist ok.
Danke Dir trotzdem für das erste scipt! Ich probiere beim ersten vielleicht mal aus die dateigrösse nicht anzeigen zu lassen, und dann evt. noch das datum der änderung raus, und dann wird´s schon bei der grossen dateimenge laufen.. 

Ich habe jetzt eine Lösung gefunden die generell nicht schlecht ist, annähernd das kann wie ich es mir vorstell, aber nicht die funktionen hat wie ich sie gern hätte.

Vielleicht kann mir da noch jemand helfen? 
Hier ist der Code:

Sub Dateiliste()
Dim pfad As String, such As String
Dim Text As String, xxl As String
Dim i As Integer, y As Integer, z As Integer
Dim info As Integer, x As Integer, anz As Integer
Dim fs
Columns("A:B").ClearContents

Set fs = Application.FileSearch

pfad = InputBox("Geben Sie den Pfad ein", , "C:\Eigene Dateien\Eigene Bilder")
If pfad = "" Then Exit Sub
With fs
    .LookIn = pfad
    .SearchSubFolders = False
    .Filename = "*.*"
  'wenn der Pfad nicht existiert Programm abbrechen
  If Dir(pfad, vbDirectory) = "" Then
      MsgBox "Falsche Pfadangabe !  Das Verzeichnis" & _
              vbCrLf & "' " & pfad & " '" & _
              vbCrLf & "existiert nicht !", _
              vbExclamation, "Fehlermeldung"
        Exit Sub
    End If

    If .Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
    z = Len(.LookIn)
    such = "\"
    Cells(2, 1) = pfad & " " & .FoundFiles.Count & " Dateien"
    y = 3
        For i = 1 To .FoundFiles.Count
        Cells(y, 2) = .FoundFiles(i)

            Text = Cells(y, 2)
            anz = Len(Cells(y, 2))
            such = "\"

          For x = 1 To anz
          info = InStr(info + 1, Text, such)
          If info = 0 Then GoTo weiter
          Cells(y, 2) = Right(Text, anz - info)
          xxl = Cells(y, 2)
            With ActiveSheet
            .hyperlinks.Add Anchor:=.Cells(y, 2), Address:=Text, _
            TextToDisplay:=xxl
            End With
          Next x
weiter:
        y = y + 1
        Next i

    Columns("A:B").AutoFit
    Else
        MsgBox "Keine Dateien gefunden"
    End If
End With
  With Columns("B:B").Font
        .Name = "Arial"
        .FontStyle = "Standard"
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 5
    End With
    With Cells(2, 2).Font
        .Name = "Arial"
        .FontStyle = "Standard"
        .Size = 15
        .ColorIndex = xlAutomatic
        .Bold = True
        [a1:b1].AutoFilter
    End With
End Sub

was mir fehlt und ich nicht kann ist:
1. ich möchte das die linke spalte nicht nur drüber sondern komplett nach unten gezogen die pfadangabe enthält,
2. möchte ich das es so wie zu sehen immer links drüber den selben count mit pfadangabe in fett darstellt, die drunter folgenden sollen dann in "normaler" schrift bzw. MINI schrift sein, weil die restlichen pfade mich nicht interessieren, und nur für den autofilter interessant sind.

dann 3. evt. noch, sollen die gleichgrossen schriften die als pfadangabe für den "autofilter in mini schrift" sind, dann noch automatisch gruppiert werden. - sofern das damit dann möglich ist.

wäre super wenn das jemand kann und mir da helfen kann! 
mfg
Chris 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP