Unterordner automatisch löschen und alle Dateien verschieben

[Lutschpuppe]

Hallo mal eine Frage habe ier ca. 480 Ordner in jeden Ordner sind auch Unterordner und in denen sind jeweils ca. 500 Dateien.

sieht folgendermaßen aus

f:\LTB - 053 - Dagobert der Milliardenakrobat\Walt Disneys Lustige Taschenbuecher 053 - Dagobert, der Milliardenakrobat (1978) (Ehapa)\img001.jpg bis img0268.img

aussehen soll es aber so

f:\LTB - 053 - Dagobert der Milliardenakrobat

und alle Dateien die im Ordner Walt Disneys Lustige Taschenbuecher 053 - Dagobert, der Milliardenakrobat (1978) (Ehapa) sind sollen nach

f:\LTB - 053 - Dagobert der Milliardenakrobat

mit anderen worten Unterordner z.b Walt Disneys Lustige Taschenbuecher 053 - Dagobert, der Milliardenakrobat (1978) (Ehapa) löschen wobei der Unterordner in den meisten fällen anderen Namen hat und alle Dateien automatisch verschieben in LTB - 053 - Dagobert der Milliardenakrobat wobei der Ordner LTB - 053 - Dagobert der Milliardenakrobat auch immer anders heist.

Geht das irgendwie ?

weil ich bekomme ja schon nach 50 Ordnern echt ne Macke.

[Stefan2]

VON:
Folder 1\Ordner 2\img001.jpg
...
Folder 1\Ordner 2\img0268.jpg

ZU:
Folder 1\img001.jpg
...
Folder 1\img0268.jpg



Siehe > http://ghisler.ch/board/viewtopic.php?p=300641#300641


- - -

Oder probier mal:

Voraussetzung:
- Backup erstellen
- Alle Dateinamen sind eindeutig (keine Doppelten)


- DOS Box öffnen
- zum Hauptornder gehen ("f:\LTB - 053.....")
- eintippen:
FOR /F "tokens=*" %f IN ('DIR /S /B /AD') DO MOVE "%f\*.*" .

(Inklusive des letzten Punktes)

Das ist die Syntax für ein deutsches DOS.
/AD bedeutet:
A Listet Dateien mit angegebenen Attributen auf.
D Verzeichnisse



- - -

Oder verwende dieses VBScript, welches auch bei Namensgleichheit eine Nummer an den Namen anhängt.

Hat bei mir funktioklappt, aber bitte erst mal austesten, bevor man es auf die wichtigen Daten loslässt.

Code: Select all

'//Purge Folders 
'//By Stefan, Version 2017.05.31_01
'//Purpose: move all files from all sub folder to start folder
'//Usage: start this script in wanted start folder
'//Found at: https://ghisler.ch/board/viewtopic.php?t=47941
'//     Unterordner automatisch löschen und alle Dateien verschieben
'//=============================================================================
Set oFSO = CreateObject("Scripting.FileSystemObject")
sStartFolder = oFSO.GetFolder(".")
MB = MsgBox("Move all files from all sub folder of " & vbLF & vbLF & sStartFolder & vbLF & vbLF & vbLF _
		& "up to that very folder?", vbOKCancel + vbQuestion,"TC Purge Folder - Debug") 
 If (MB = vbCancel) Then WScript.Quit 
'//=============================================================================
sDebugLogTxt = ""				'initialize variable for later use
iProcessedFilesCounter = 0		'count amount of precessed files
iDoubleFileSerial = 2			'start counter for first double file name
bShowDebugLog = True			'Show log at the end? (TRUE for Yes, show me. FALSE for No, thanks)
'//=============================================================================
RecurseFolders(sStartFolder)
Sub RecurseFolders(strFolder)
	Set oStartFolder = oFSO.GetFolder(strFolder)
	For Each oFolder In oStartFolder.SubFolders
		For Each oFile In oFolder.Files
			iProcessedFilesCounter = iProcessedFilesCounter + 1
			sFile = oFile.Name 
			If oFSO.FileExists(sStartFolder & "\" & sFile) Then
				sBase = oFSO.GetBaseName(sFile)
				sExte = oFSO.GetExtensionName(sFile)
				Do While oFSO.FileExists(sStartFolder & "\" & sBase & "_" & iDoubleFileSerial & "." & sExte)
					iDoubleFileSerial = iDoubleFileSerial + 1
				Loop
				sFile = sBase & "_" & iDoubleFileSerial & "." & sExte
				iDoubleFileSerial = 2 '//back to wanted start
			End If
			sDebugLogTxt = sDebugLogTxt & oFile.path & vbTAB & sStartFolder & "\" & sFile & vbCRLF
			oFSO.MoveFile oFile.path, sStartFolder & "\" & sFile
		Next
		RecurseFolders oFolder.Path
	Next
End Sub 'RecurseFolders
sDebugLogTxt = "Moved " & iProcessedFilesCounter & " files:" & vbCRLF & sDebugLogTxt
'//=============================================================================
If bShowDebugLog Then
	If iProcessedFilesCounter > 0 Then
		'//Show MessageBox:
		'MsgBox sDebugLogTxt,0,"TC Purge Folder - Debug"
		'//Write to log file:
		N = Now
		D = Year(N) & Right("00" & Month(N), 2) & Right("00" & Day(N), 2)
		T = Right("00" & Hour(N), 2) & Right("00" & Minute(N), 2) & Right("00" & Second(N), 2)
		SET WSO = CreateObject("wscript.Shell")
		UserTEMP = WSO.ExpandEnvironmentStrings("%tmp%")
		Set FileOut = oFSO.OpenTextFile(UserTEMP & "\TC_PurgeFolder_" & D & T & ".log" , 8, true)
		FileOut.WriteLine (Now() & ": " & sDebugLogTxt) : FileOut.Close
		WSO.run "notepad.exe " & UserTEMP & "\TC_PurgeFolder_" & D & T & ".log" 
	ELSE
		MsgBox "Nothing found to move!"
	End If
End If
'//=============================================================================