Application.FileSearch
Reinhardt
ich habe einen für mich "kleinen Schatz" im Archiv gefunden, der aber leider bei mir eine Fehlermeldung erzeugt:
Objekt unterstützt diese Action nicht
With Application.FileSearch
Was kann ich machen?
Gruß Reinhardt.
Problem: In Spalte A sollen die Dateien aus dem in Zelle A1 genannten Verzeichnis einschl. aller Unterverzeichnissen mit Hyperlinks gelistet und in Spalte B soll das zugehörige Dateidatum eingetragen werden.
StandardModule: Modul1
Sub ScanDir()
Dim lRow As Long, lCounter As Long
Dim iCol As Integer
lRow = 1
iCol = 1
With Application.FileSearch
.LookIn = Range("A1").Value
.SearchSubFolders = True
.Execute
For lCounter = 1 To .FoundFiles.Count
lRow = lRow + 1
If lRow = 65537 Then
lRow = 2
iCol = iCol + 1
End If
Cells(lRow, iCol).Value = .FoundFiles(lCounter)
Cells(lRow, iCol).Hyperlinks.Add _
Cells(lRow, iCol), .FoundFiles(lCounter)
Cells(lRow, iCol + 1).Value = FileDateTime(.FoundFiles(lCounter))
Next lCounter
End With
Columns.AutoFit
End Sub