Option Explicit
Sub Alex()
Dim arrFiles
Const strTyp As String = ".pdf"
DateiListe arrFiles, strTyp
End Sub
Sub DateiListe(arrFiles, ByVal strTyp As String)
Dim FSO As Object, oFolder As Object, oDictF As Object
Dim strFolder As String
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
.AllowMultiSelect = False
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strFolder)
Set oDictF = CreateObject("Scripting.dictionary")
prcFiles oFolder, oDictF, strTyp
prcSubFolders oFolder, oDictF, strTyp
arrFiles = oDictF.Keys
End Sub
Sub prcFiles(oFolder, oDictF, strTyp)
Dim oFile As Object
For Each oFile In oFolder.Files
If Right(oFile.Name, 4) = strTyp Then oDictF(oFile.Path) = 0
Next
End Sub
Sub prcSubFolders(oFolder, oDictF, strTyp)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder, oDictF, strTyp
prcSubFolders oSubFolder, oDictF, strTyp
Next
End SubDie erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen