Sub DatSuchen() 'incl. Unterordner!!!!!!!!!!!
Application.ScreenUpdating = False
Dim i As Integer, alledocs As Integer
Dim getdocdat As String 'Pfad und Dateiname
Dim docfile As String 'Dateiname
Dim docpfad As String 'Pfad
dat_Pfad = "E:\" 'unterstellt wird Lw E
Application.StatusBar = "Suche Dateien"
'Löschen tmp-Sheet (hier werden die Ergebnisse abgelegt)
Workbooks(ThisWorkbook.Name).Worksheets("tmp"). _
Columns("A:H").ClearContents
'dats ermitteln
With Application.FileSearch
.LookIn = dat_Pfad
.SearchSubFolders = True
.Filename = "*.*" 'hier kann man auch gezielter suchen (*.doc)
If .Execute() > 0 Then
alledocs = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
getdocdat = .FoundFiles(i)
'Trennung von Pfad und Datei
For getdocdatLen = 1 To Len(getdocdat)
If Mid(getdocdat, getdocdatLen, 1) = "\" Then _
Zw_IndLen = getdocdatLen
Next getdocdatLen
docfile = Right(getdocdat, Len(getdocdat) - Zw_IndLen)
docpfad = Left(getdocdat, Len(getdocdat) - Len(docfile))
'Eintragen in tmp-Sheet
Workbooks(ThisWorkbook.Name).Worksheets("tmp"). _
Cells(i, 1).Value = docfile
Workbooks(ThisWorkbook.Name).Worksheets("tmp"). _
Cells(i, 2).Value = docpfad
Workbooks(ThisWorkbook.Name).Worksheets("tmp"). _
Cells(i, 3).Value = getdocdat
Next i
End If
End With
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen