Dateiverzeichnis einlesen

Forumthread: Dateiverzeichnis einlesen

08.08.2007 15:18:00

Hermann

Hallo,
ich habe mir aus verschieden Beiträgen hier im Forum folgenden VBA gebastelt.
Es soll ein Dateiverzeichnis in ein Tabellenblatt eingelesen werden und zwar jedesmal wenn das Tabellenblatt aktiviert wird.
So der Plan.
Fakt ist, daß das Verzeichnis im Blatt jedoch nur einmalig angelegt wird.
Aktalisierungen des Verzeichnisses werden nicht übernommen.
Vielen Dank schon einmal für Eure Hilfe.
Gruß
Hermann


Private Sub Worksheet_Activate()
Call finde_file
End Sub

Sub finde_file()
Dim i As Long
With Application.FileSearch
.NewSearch
.LookIn = "M:\Pfad\Verzeichnis\"
.SearchSubFolders = False
.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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Dateiverzeichnis einlesen

08.08.2007 15:50:19

Rudi

Hallo,


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

Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

AW: Dateiverzeichnis einlesen

08.08.2007 16:20:23

Hermann

Hallo Rudi,
funktioniert leider nicht.
Beim Debuggen hat FileTyp den Wert 1, wenn Dir das weiterhilft.
Gruß
Hermann

AW: Dateiverzeichnis einlesen

08.08.2007 16:46:00

Ramses

Hallo
Lösch mal die Zeile
.FileType=msoFileTypeAllFiles
Das bezieht sich meines Wissens nur MS-Filetypen, du suchst aber nach PDF Dateien
Gruss Rainer

AW: Dateiverzeichnis einlesen

08.08.2007 17:56:00

Hermann

Hallo Rainer,
das Einfügen der Zeile
FileType=msoFileTypeAllFiles
war ja gerade der Verbesserungsvorschlag von Rudi, oder habe ich da was übersehen?
Zitat: "Das bezieht sich meines Wissens nur MS-Filetypen, du suchst aber nach PDF Dateien"
..welche Dateitypen eingelesen werden, muß von der Aktualisierung unabhängig sein.
Gruß
Hermann

AW: Dateiverzeichnis einlesen

08.08.2007 18:40:00

Ramses

Hallo
Rechte Maustaste auf den Tabellenreiter wo du das Inhaltsverzeichnis haben willst
Code Anzeigen
Diesen Code dort reinkopieren

Option Explicit

Private Sub Worksheet_Activate()
    '(C) Ramses
    'erstellt Inhaltsverzeichnis mit Hyperlinks
    Dim i As Long, myPfad As String, myFileType As String
    'VErzeichnis mit Backslash am Ende angeben!!
    '***********************************
    'Anpassen
    myPfad = "D:\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("A1")
        .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
            End With
        Next i
    End With
End Sub

Anschliessend den Pfad anpassen, und die Tabelle aktivieren.
Gruss Rainer

AW: Dateiverzeichnis einlesen

09.08.2007 10:16:00

Hermann

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

AW: Dateiverzeichnis einlesen

09.08.2007 10:45:23

Ramses

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

AW: Dateiverzeichnis einlesen

09.08.2007 13:42:00

Hermann

Hallo Rainer,
Problem 2 ist nun geklärt. Dateinamen werden korrekt angezeigt. :-)
Bei der Aktualisierung werden jeoch immer noch alle Spalten gelöscht und dann Spalte T eingefügt. :-(
Gruß
Hermann

AW: Dateiverzeichnis einlesen

09.08.2007 19:18:00

Ramses

Hallo
Lösche die Zeile "Cells.Clear"
Gruss Rainer

AW: Dateiverzeichnis einlesen

10.08.2007 09:15:00

Hermann

Hallo Rainer,
funktioniert super.
Vielen Dank !!!!
Gruß
Hermann

Beliebteste Forumthreads (12 Monate)

Forumthread: Dateiverzeichnis einlesen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread