Unterordner mit Dir durchsuchen

Forumthread: Unterordner mit Dir durchsuchen

Tobias

Hallo,
ich habe in VBA ein Such funktion geschrieben, die nach einer bestimmten Datei in einem Ordner sucht.
Jetzt soll die Funktion auch die Unterordner durchsuchen. Ich habe das mit Dir gelöst.
Hier meine Funktion

Public Function findfiles(sFileName) As String
'--Funktion gibt ein zusammengestelltes String-Kürzel der gefundenen Dateierweiterungen zurück
'--z.B.: " msg ppt doc"
'--In diesem Pad wird gesucht
Const sPath = "W:\Proj\CBD\001_TEAMDRIVE\Tribo_Systems\100_Reports"
findfiles = ""
If sFileName = "" Then Exit Function
If Dir(sPath & "\" & sFileName & ".msg")  "" Then
findfiles = findfiles & " msg"
End If
If Dir(sPath & "\" & sFileName & ".doc")  "" Then
findfiles = findfiles & " doc"
End If
If Dir(sPath & "\" & sFileName & ".pdf")  "" Then
findfiles = findfiles & " pdf"
End If
If Dir(sPath & "\" & sFileName & ".ppt")  "" Then
findfiles = findfiles & " ppt"
End If
If Dir(sPath & "\" & sFileName & ".pptx")  "" Then
findfiles = findfiles & " pptx"
End If
If Dir(sPath & "\" & sFileName & ".docx")  "" Then
findfiles = findfiles & " docx"
End If
End Function

Danke schon mal für die Antwort

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Unterordner mit Dir durchsuchen

Tobias
AW: Unterordner mit Dir durchsuchen

Rudi

AW: Unterordner mit Dir durchsuchen

02.04.2012 10:07:27

Tobias

Frage ist, wie muss ich denn VBA Code ändern?
Danke

AW: Unterordner mit Dir durchsuchen

02.04.2012 16:26:41

Rudi

Hallo,

Sub aaa()
MsgBox FindFiles("mappe16")
End Sub
Public Function FindFiles(sFileName) As String
'--Funktion gibt ein zusammengestelltes String-Kürzel der gefundenen Dateierweiterungen zurück
'--z.B.: " msg ppt doc"
Dim FSO As Object, oFolder As Object, oDictF As Object
'--In diesem Pad wird gesucht
Const sPath = "W:\Proj\CBD\001_TEAMDRIVE\Tribo_Systems\100_Reports"
If sFileName = "" Then Exit Function
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(sPath)
Set oDictF = CreateObject("Scripting.dictionary")
prcFiles oFolder, oDictF, sFileName
prcSubFolders oFolder, oDictF, sFileName
If oDictF.Count Then
FindFiles = Join(oDictF.keys, " ")
Else
FindFiles = sFileName & " nicht vorhanden."
End If
End Function
Sub prcFiles(oFolder, oDictF, sFileName)
Dim oFile As Object
For Each oFile In oFolder.Files
With oFile
If InStr(.Name, ".") Then
If LCase(Left(.Name, InStrRev(.Name, ".") - 1)) = LCase(sFileName) Then
oDictF(Right(.Name, Len(.Name) - InStrRev(.Name, "."))) = 0
End If
End If
End With
Next
End Sub
Sub prcSubFolders(oFolder, oDictF, sFileName)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder, oDictF, sFileName
prcSubFolders oSubFolder, oDictF, sFileName
Next
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Forumthread: Unterordner mit Dir durchsuchen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread