Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1256to1260
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Unterordner mit Dir durchsuchen

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
Anzeige
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige