AW: Dateinamen ausgeben
05.01.2006 12:00:52
Wolfram
Hallo Hans,
versuch's mal mit dieser Lösung (habe ich auch nur abgekupfert und für mich angepasst).
Du brauchst ein Sheet "tmp" für die Ergebnisse.
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
Gruß
Wolfram