AW: Ordner mit Dateien auslesen
21.03.2006 09:11:23
Gustav
Hallo Darren versuch mal folgenden Code:
Sub Dateiname
Dim StDateiname As String
Dim Dateiform As String
Dim InI As Long, TotFiles As Long
Dim Suchpfad As String
Dim OldStatus As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
OldStatus = Application.StatusBar
' neue Tabelle anlegen
Sheets.Add After:=Worksheets(Worksheets.Count)
With Application.FileSearch
.LookIn = Suchpfad ' Suchverzeichnis
.SearchSubFolders = True ' suchen auch in Unterverzeichnis
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For InI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei: " & InI & " von " & TotFiles
' ergänzt Hyperlink, Dateigröße und Dateidatum
' Dateiname abtrennen für alle Versionen unte Xp
' For InI = Len(.FoundFiles(InI)) To 1 Step -1
' If Mid(.FoundFiles(InI), InI, 1) = "\" Then
' StDateiname = Mid(.FoundFiles(InI), InI + 1, Len(.FoundFiles(InI)) - InI + 2)
' Exit For
' End If
' Next InI
' Dateiname abtrennen ab XP
StDateiname = Mid(.FoundFiles(InI), InStrRev(.FoundFiles(InI), "\") + 1)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(InI, 1), _
Address:=.FoundFiles(InI), TextToDisplay:=StDateiname ' Hyperlink
Cells(InI, 2) = FileLen(.FoundFiles(InI)) ' Dateigröße
Cells(InI, 3) = FileDateTime(.FoundFiles(InI)) ' Dateidatum
Next InI
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub
Gruss Gustav