Dateiverzeichnis einlesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub finde_file() Dim i As Long With Application.FileSearch .NewSearch .LookIn = "M:\Pfad\Verzeichnis\" .SearchSubFolders = False .FileType=msoFileTypeAllFiles .Filename = "*.pdf" .Execute For i = 1 To .FoundFiles.Count Worksheets("Tabelle1").Hyperlinks.Add anchor:=Worksheets("Tabelle1").Cells(i, 20), Address:=. _ FoundFiles(i) For j = Len(Cells(i, 20)) To 1 Step -1 If Cells(i, 20).Characters(j, 1).Text = "\" Then Cells(i, 20) = Right(Cells(i, 20), Len(Cells(i, 20)) - j) End If Next j Next i End With End Sub

Hallo Rainer,
die Aktualisierung funktioniert nun super!!
Jedoch haben sich mit Deinem Code nun zwei Probleme eingeschlichen, die mit meinem Code nicht auftraten.
1. Bei der Aktualisierung wird das gesammte Blatt gelöscht.
Das Verzeichnis soll aber nur in eine best. Spalte (in meinem Bsp. Spalte T) eingefügt werden ohne bestehende andere Spalten zu löschen.
2.Es wird die komplete Pfadbezeichnung angezeigt.
In Spalte T soll aber nur der Dateiname erscheinen. Ich habe deshalb - entgegen deinem Rat - den unteren Teil Deines Codes geändert.
Nun wird der Dateiname in den ersten Zeilen der Spalte T angezeigt, aber in der allerletzen eingelesenen Zeile der Spalte T nicht. Hier wird weiterhin der komplete Pfad angezeigt.
Ich bekomme das einfach nicht hin mit dem Zähler. Vielleicht hat es auch mit Deiner zusätzlichen 1.Zeile "Verzeichnis von..." zu tun. Diese benötige ich eigentlich nicht.
Hier Dein von mir geänderter Code
Option Explicit


Private Sub Worksheet_Activate()
'(C) Ramses
'erstellt Inhaltsverzeichnis mit Hyperlinks
Dim i As Long, myPfad As String, myFileType As String
Dim j As Long
'VErzeichnis mit Backslash am Ende angeben!!
'Anpassen
myPfad = "M:\Pfad\"
'myFileType in Form von "*.xls", "*.pdf" angeben
myFileType = "*.pdf"
'Ab hier nichts mehr ändern
If Dir(myPfad & myFileType) = "" Then
MsgBox "Das Verzeichnis: """ & myPfad & """ enthält keine Dateien vom Typ: """ &  _
myFileType, vbInformation + vbOKOnly, "Fehler"
Cells.Clear
Exit Sub
End If
ChDrive Left(myPfad, 1)
ChDir myPfad
Cells.Clear
With Range("T1")
.Value = "Inhaltsverzeichnis von " & myPfad
.Offset(1, 0).Select
End With
With Application.FileSearch
.NewSearch
.LookIn = myPfad
.SearchSubFolders = False
.Filename = myFileType
.Execute
For i = 1 To .FoundFiles.Count
With ActiveCell
.Value = Application.FileSearch.FoundFiles(i)
.Hyperlinks.Add Anchor:=ActiveCell, Address:="" & Application.FileSearch. _
FoundFiles(i) & "", TextToDisplay:="" & Application.FileSearch.FoundFiles(i) & ""
.Offset(1, 0).Select
' Dateiname wird angezeigt
For j = Len(Cells(i, 20)) To 1 Step -1
If Cells(i, 20).Characters(j, 1).Text = "\" Then
Cells(i, 20) = Right(Cells(i, 20), Len(Cells(i, 20)) - j)
End If
Next j
End With
Next i
End With
End Sub

Gruß
Hermann

Hallo
probier mal

Option Explicit

Private Sub Worksheet_Activate()
    '(C) Ramses
    'erstellt Inhaltsverzeichnis mit Hyperlinks
    Dim i As Long, myPfad As String, myFileType As String
    Dim verzSpalte As String
    Dim tmpName As String
    'VErzeichnis mit Backslash am Ende angeben!!
    '***********************************
    'Anpassen
    myPfad = "D:\Schiller\__Medica\"
    'myFileType in Form von "*.xls", "*.pdf" angeben
    myFileType = "*.pdf"
    'In dieser Spalte soll das Verzeichnis stehen
    verzSpalte = "T"
    'Ab hier nichts mehr ändern
    '************************************
    If Right(myPfad, 1) <> "\" Then
        myPfad = myPfad & "\"
    End If
    If Dir(myPfad & myFileType) = "" Then
        MsgBox "Das Verzeichnis: """ & myPfad & """ enthält keine Dateien vom Typ: """ & myFileType, vbInformation + vbOKOnly, "Fehler"
        Columns(verzSpalte).Clear
        Exit Sub
    End If
    ChDrive Left(myPfad, 1)
    ChDir myPfad
    Cells.Clear
    With Range(verzSpalte & "1")
        .Value = "Inhaltsverzeichnis von " & myPfad
        .Offset(1, 0).Select
    End With
    With Application.FileSearch
        .NewSearch
        .LookIn = myPfad
        .SearchSubFolders = False
        .Filename = myFileType
        .Execute
        For i = 1 To .FoundFiles.Count
            tmpName = Application.FileSearch.FoundFiles(i)
            tmpName = Right(tmpName, Len(tmpName) - InStrRev(tmpName, "\", -1))
            With ActiveCell
                .Value = tmpName
                .Hyperlinks.Add Anchor:=ActiveCell, Address:="" & Application.FileSearch.FoundFiles(i) & "", TextToDisplay:="" & tmpName & ""
                .Offset(1, 0).Select
            End With
        Next i
    End With
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread