Option Explicit
Private Sub Beispielaufruf()
Dim FileList$(), I&, List$()
DirectoryContent List, ThisWorkbook.Path
For I = 0 To UBound(List)
MsgBox List(I)
Next
End Sub
Function DirectoryContent( _
List$(), ByVal sPath$, _
Optional ByVal bSubfolders As Boolean = False, _
Optional ByVal sFilenameFilter$ = "*", _
Optional ByVal sExtensionFilter$ = "*" _
) As String
Dim oFS As Object, OFolder As Object, oSubfolder As Object, oFile As Object
Dim Count&
DirectoryContent = "No Files found"
If FolderDoesntExist(sPath) Then
DirectoryContent = "Folder doesn't exist"
Exit Function
End If
Set oFS = CreateObject("Scripting.FileSystemObject")
Set OFolder = oFS.GetFolder(sPath)
For Each oFile In OFolder.Files
If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then
ReDim Preserve List(Count)
List(Count) = oFile.Path
Count = Count + 1
DirectoryContent = vbNullString
End If
Next
If bSubfolders Then
For Each oSubfolder In OFolder.SubFolders
For Each oFile In oSubfolder.Files
If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then
ReDim Preserve List(Count)
List(Count) = oFile.Path
Count = Count + 1
DirectoryContent = vbNullString
End If
Next
Next
End If
Set oFS = Nothing
Set oFile = Nothing
Set oSubfolder = Nothing
Set OFolder = Nothing
End Function
Private Function FolderDoesntExist(sPath$) As Boolean
Dim OFolder As Object
Dim oFS As Object
On Error GoTo FolderDoesNotExist
Set oFS = CreateObject("Scripting.FileSystemObject")
FolderDoesntExist = 0
Set OFolder = oFS.GetFolder(sPath)
Set oFS = Nothing
Set OFolder = Nothing
Exit Function
FolderDoesNotExist:
Set oFS = Nothing
Set OFolder = Nothing
FolderDoesntExist = 1
End Function
Function RenameFilesInDirectory(Directory As String, NewDir As String, Optional ByVal NotFile As String = "")
Dim X As Variant
Dim NewFile As String
Dim DirCont$()
DirectoryContent DirCont, Directory
On Error Resume Next
For Each X In DirCont
If Not X = "" Then
If Not X = NotFile Then
NewFile = NewDir & Right(X, Len(X) - Len(Directory))
Kill NewFile
Name X As NewFile
End If
End If
Next X
End Function