---

Servus

Hab ein Makro das mir die neueste Datei in einem Verzeichnis durchsucht, es müssten aber auch alle Unterverzeichnisse berücksichtigt werden.
kann mir da wer helfen

die Pfade stehen in Spalte A
die Dateien werden in Spalte B geschrieben
die Datums werden in Spalte C geschrieben

Code:

---

Sub Find_New_Filedate()
'von Rainer (Ramses)
'Liefert jüngste Datei in einem Verzeichnis
'Dim I As Long
Dim strDateiname As String, strPath As String, strDEW As String
Dim StoreDate As Date, StoreName As String
'Variablen setzen
    On Error GoTo ErrorHandler
    'Pfad
    For i = 2 To 10
        strPath = Cells(i, 1).Value & "\" ' mit Backslash endend!
    'Dateierweiterung
    strDEW = "*"
    strDateiname = Dir(strPath & strDEW)
    Do While (strDateiname <> "")
        If FileDateTime(strPath & strDateiname) > StoreDate Then
            StoreDate = FileDateTime(strPath & strDateiname)
            StoreName = Dir()
        End If
        strDateiname = Dir()
    Loop
    If StoreDate = 0 Then
        MsgBox "Keine Dateien dieses Typs " & strDEW & " gefunden"
    Else
        Cells(i, 2).Value = StoreName
        Cells(i, 3).Value = StoreDate
    End If
    Next
    Exit Sub
ErrorHandler: MsgBox "Das Verzeichnis: " & strPath & " konnte nicht gefunden werden! "
End Sub

---

------------------
<----- Bitte Systeminfo eintragen, warum siehst du hier. "Warum Einfach es geht auch kompliziert". Schöne Grüsse aus der Steiermark  Bernd P. Sport ist Mord
Rekorde: Scalelist>11727, Fehler>34365, Layerfilter>XXXX

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

schau dir mal die Routine FindFiles auf VB-Tec an, das benutze ich in solchen Situationen häufig.

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de
Stefans SolidWorks Blog

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Bernd,

 

Zitat:

---

es müssten aber auch alle Unterverzeichnisse berücksichtigt werden.

---

das ist nur mit rekursiven Funktionsaufrufen sinnvoll realisierbar,
rekursion ist mit DIR gedoch(fast) unmöglich.

Die Anwendung der API, wie von Stefan vorgeschlagen, ist doch recht spröde.

Ich habe mal eine Variante mit dem Scripting.Filesystemobject erstellt.
Verweis auf 'Microsoft Scripting Runtime' mus gesetzt sein!

Code:

---

Function Find_New_Filedate(Ordner As Folder, _
                           Optional name As String = "*", _
                           Optional start As Date = CDate("0.0.0"), _
                           Optional rec As Boolean = True) As file
Dim store As file
Dim sStore As file
Dim datei As file
Dim subs As Folder
Dim StoreDate As Date, StoreName As String
    StoreDate = start
    For Each datei In Ordner.Files
    If datei.name Like name Then
        If datei.DateLastModified > StoreDate Then
            Set store = datei
            StoreDate = datei.DateLastModified
        End If
    End If
    Next
    If rec Then
      For Each subs In Ordner.SubFolders
        Set sStore = Find_New_Filedate(subs, name, StoreDate, rec)
        If Not sStore Is Nothing Then
            Set store = sStore
            StoreDate = store.DateLastModified
         End If
       Next
     End If
Set Find_New_Filedate = store
  
End Function

Sub Find_New()
Dim strDateiname As String, strPath As String, strDEW As String
'Variablen setzen
Dim ff As file
Dim fs As New FileSystemObject
'altanativ ohne Verweis auf 'Microsoft Scripting Runtime'
'DIM fs as object
'Set fs = CreateObject("Scripting.Filesystemobject")   

    For i = 2 To 10
        strPath = Cells(i, 1).Value & "\" ' mit Backslash endend!
        If strPath <> "\" And Dir(strPath, vbDirectory) <> "" Then
      
            Set ff = Find_New_Filedate(Ordner:=fs.GetFolder(strPath))
            If Not ff Is Nothing Then
                Cells(i, 2).Value = ff.name
                Cells(i, 3).Value = ff.DateLastModified
            Else
                MsgBox "Keine Dateien dieses Typs  gefunden" & vbCrLf & "in" & strPath
            End If
        Else
            MsgBox "Das Verzeichnis: " & strPath & " konnte nicht gefunden werden! "
        End If
    Next
End Sub

---

Das unsägliche "ON ERROR GOTO ..." habe ich auch noch beseitigt 

Gruß
Peter

[Diese Nachricht wurde von Comos User am 08. Nov. 2010 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP