Set WshShell = CreateObject("Wscript.Shell")
Pfad = WshShell.CurrentDirectory
 
If Right(Pfad,1)<>"\" then
	Pfad = Pfad & "\"
end if
 
Pfad_save = Pfad & "save\"
 
Set FSO=CreateObject("Scripting.FileSystemObject")
Set Folder=FSO.GetFolder(Pfad)
 
If FSO.folderExists("save") = False then
	FSO.createfolder("save")
end if
 
Do
	Kopieren
	WScript.Sleep 120000
Loop
 
Function Kopieren
	For Each File in Folder.Files
 
	v_datum = mid(date,9,2) & mid(date,4,2) & mid(date,1,2) & "_" & mid(time,1,2) _
  & mid(time,4,2)
 
		If Right(File,3) <> "vbs" and Right(File,3) <> "exe" Then
 
			x = Split(file,"_")
 
			If FSO.FolderExists(x(1)) = False Then
				FSO.CreateFolder(x(1))
			End If
 
			Pfad_neu = Pfad & x(1) & "\" & x(2)
			FSO.CopyFile file,Pfad_neu
 
			y = Split(file,"\")
			v_file = v_datum & "_" & y(Ubound(y))
			FSO.MoveFile file, Pfad_save & v_file
 
		End if
 
	Next
End Function