[haze303]

Soll sollte es funktionieren:

On Error Resume Next

Dim strFolder, oFSO, oFile, oFolder

Set oFSO = WS*****.CreateObject("S*****ing.FileSystemObject")
strFolder = oFSO.GetAbsolutePathName(".")

If oFSO.FolderExists(strFolder) Then 
        For Each oFolder In oFSO.GetFolder(strFolder).SubFolders                                      
        	For Each oFile In oFolder.Files
            	   oFSO.MoveFile oFile.Path, strFolder & "\" & oFile.Name
        	Next
        Next 
End If

Nicht die schönste Lösung, aber sie funktioniert.
Leider bin ich momentan etwas kurz gebunden, sodass für eine professionelle Lösung keine Zeit bleibt.