AW: Ordner durchsuchen, einschl. Unterordner
04.09.2018 15:02:06
PeterK
Hallo
Code mit Filterkriterien
Sub MyMain()
Const myPath = "C:\Users\Downloads\"
Const myName = "3662555379"
Const myType = "pdf"
Dim fso As Object
Dim startFolder As Object
Dim foundFile As String
Dim foundVersion As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set startFolder = fso.getfolder(myPath)
If startFolder Is Nothing Then
Debug.Print "Folder " & myPath & " does'nt exist ..."
Else
foundFile = ""
foundVersion = 0
Call GetFiles(startFolder, myName, myType, foundFile, foundVersion)
Debug.Print foundFile
End If
End Sub
Sub GetFiles(folder As Object, seaName As String, seaType As String, foundFile As String, _
foundVersion As Long)
Dim subFolder As Object
Dim allFiles As Object
Dim myFile As Object
Dim splitArray() As String
Dim myVersion As Long
For Each subFolder In folder.subfolders
Call GetFiles(subFolder, seaName, seaType, foundFile, foundVersion)
Next
Set allFiles = folder.Files
For Each myFile In allFiles
splitArray = Split(myFile.Name, ".") ' hier wird Dateiname/Dateityp getrennt
If UCase(splitArray(UBound(splitArray))) = UCase(seaType) Then
' wir haben den richtigen Dateityp
If UCase(seaName) = Mid(UCase(splitArray(LBound(splitArray))), 1, Len(seaName)) Then
' wir haben den richtigen Dateinamen und ermitteln die Version
splitArray = Split(myFile.Name, "[")
If UBound(splitArray) > 0 Then
splitArray = Split(splitArray(UBound(splitArray)), "]")
myVersion = CInt(splitArray(LBound(splitArray)))
If myVersion > foundVersion Then
foundVersion = myVersion
foundFile = myFile.Path
End If
End If
End If
End If
Next
End Sub