[Solved] Dateien zusammenführen: Unterordner auflösen.

German support forum

Moderators: sheep, Hacker, Stefan2, white

pgomes
Junior Member
Junior Member
Posts: 37
Joined: 2009-12-20, 16:39 UTC

Re: [Solved] Dateien zusammenführen: Unterordner auflösen.

Post by *pgomes » 2018-08-27, 18:16 UTC

Stefan2 wrote:
2018-08-27, 14:33 UTC
2pgomes
Von welcher Batchdatei redest du?
Poste mal deine verwendete Batch, dann kann die jemand anpassen.
ja mache ich, bitte schön


Code: Select all

@ECHO OFF
CD /D %1
COLOR 4F
echo Aufl”sen aller Unterordner von %CD%\?
echo.
CHOICE /T 30 /C JNA /D A /M "Drcken Sie J fr Ja, N fr Nein ein oder A fr Abbrechen oder 30 Sekunden warten (Autoabbruch)"
if errorlevel 3 goto Abbrechen
if errorlevel 2 goto nein
if errorlevel 1 goto ja

:ja
echo.
ECHO Ordner aufl”sen
timeout 10
FOR /R %%f IN (*) DO MOVE "%%f" .
FOR /D /R %%f IN (*) DO RD "%%f"
goto :EOF (Springe ans Ende)

:nein
echo.
ECHO Es wurde nein ausgew„lt & COLOR 2F
timeout 10
goto :EOF

:Abbrechen
echo.
ECHO Programm wird abgebrochen & COLOR 2F & timeout 10

User avatar
Stefan2
Power Member
Power Member
Posts: 2640
Joined: 2007-09-13, 22:20 UTC
Location: Europa

Re: [Solved] Dateien zusammenführen: Unterordner auflösen.

Post by *Stefan2 » 2018-08-27, 18:25 UTC

Danke schön.


Das "DOS"-Kommando 'move' hat einen Parameter zur Nachfrage:

Code: Select all

C:\Users\User>move /?
Verschiebt Dateien und benennt Dateien und Verzeichnisse um.
MOVE [/Y| /-Y] [Laufwerk:][Pfad]Datei1[,...] Ziel

  /-Y                      Fordert vor dem Überschreiben bestehender Zieldateien zur Bestätigung auf.

C:\Users\User>

FOR /R %%f IN (*) DO MOVE "%%f" .
FOR /R %%f IN (*) DO MOVE /-Y "%%f" .



(Da ist ein Punkt am Ende (Kürzel für "aktuelles Verzeichnis"))


 
Inofficial FAQs || WIKI (Deu/Eng) || TC Home (What's new? // FAQ // Download // Order // Addons // Tools // Plugins)
Erst wenn der letzte Baum gefällt oder die letzte Biene verendet ist, werden die Leute verstehen warum Umweltschutz wichtig ist.

pgomes
Junior Member
Junior Member
Posts: 37
Joined: 2009-12-20, 16:39 UTC

Re: [Solved] Dateien zusammenführen: Unterordner auflösen.

Post by *pgomes » 2018-08-27, 19:13 UTC

danke danke

was passiert, wenn "nein" gedrückt wird, wird alles abgebrochen oder wird nur die datei nicht verschoben und dann aber trotzdem der ordner gelöscht?

würde es auch gehen, dass die datei automatisch umbenannt wird also irgendwas angehängt?

User avatar
Stefan2
Power Member
Power Member
Posts: 2640
Joined: 2007-09-13, 22:20 UTC
Location: Europa

VBScript: Dateien zusammenführen ; Unterordner auflösen ; Verschieben

Post by *Stefan2 » 2018-08-28, 10:07 UTC

@pgomes

Hier mal ein VBScript dafür.

Führe es im aktuellen Ordner aus, zuerst sieht man eine Meldung.
Danach werden alle Dateien aller Unterordner in eben diesen aktuellen Ordner verschoben.
Verschobene Dateien mit selben Namen wie bereits vorhanden werden umbenannt, indem eine Zahl (_2, _3,..siehe USER SETTINGS) angehängt wird.
Anschließen werden die Unterordner gelöscht (siehe USER SETTINGS)


ANWENDUNG

1.) Speichere diesen Code als "PurgeFolders.vbs" im TC-Ordner.

2.) Erstelle einen Button:
Kommando: "%Commander_Path%\PurgeFolders.vbs"
Parameters:
Start path/Startpfad: <LEER lassen!!!>
Icon: WCMICONS.DLL
Tooltip: Purge Sub-Folders // Säubere Unterordner


3.) Wechsele im TC in den gewünschten Ordner. (erst mal mit einen Test-Ordner versuchen)

4.) Klicke auf den neuen Button.
LESE die Meldung und klicke einen Button

Fertig.

Code: Select all

'//=============================================================================
'//Purge Sub-Folders // Säubere Unterordner
'//By Stefan, Version 2018.08.28.01 
'//Found at: https://ghisler.ch/board/viewtopic.php?p=346604#p346604
'
'//Purpose: move all files from all sub folder to start folder
'//Usage: start this script in wanted start folder (Mainfolder)
'
'//Verwendungszweck: Unterordner automatisch löschen und alle Dateien in das aktuelle Verzeichnis verschieben
'//Verwendung: Starte dieses Skript im gewünschtem Hauptordner (Mainfolder)

'VON:
'MainFolder\Ordner 2\img001.jpg
'MainFolder\Ordner 2\Sub\img001.jpg
'MainFolder\Ordner 2\img0268.jpg
'...
'
'ZU:
'MainFolder\img001.jpg
'MainFolder\img001_2.jpg
'MainFolder\img0268.jpg
'...
'
'
'//============================================================================= TC Button
'  Command/Kommando:     "X:\Path to\This Script.ext"
'  Parameters: 
'  Start path/Startpfad:
'  Icon:                 WCMICONS.DLL
'  Tooltip:              Purge Sub-Folders // Säubere Unterordner
'//============================================================================= SCRIPT BASICS
Set FSO      = CreateObject("Scripting.FileSystemObject")
SET WSO      = CreateObject("wscript.Shell")
UserTEMP     = WSO.ExpandEnvironmentStrings("%tmp%")
sStartFolder = FSO.GetFolder(".")
strLogText = ""				    'initialize variable for later use
iProcessedFilesCounter = 0		'count amount of precessed files
iProcessedFolderCounter= 0
'//============================================================================= USER SETTINGS
strLanguageSprache = "Deutsch" 'MsgBox Deutsch or English
iDuplicateFilesSerial  = 2     'start counter for first double file name
iWantedPadding     = 0         'pad iDuplicateFilesSerial with zero's (0 or 1 for NO, else 2 or more for 01,02...)
bShowDebugLog      = True      'Show log at the end? (TRUE for Yes, please. FALSE for No, thanks)
bDelete_SubFolders = True      'Delete sub folders after purging?
strLogFile         = UserTEMP & "\TC_PurgeFolder_" & Timestamp & ".log" 
'//============================================================================= PROMPT THE USER
If (lcase(strLanguageSprache) = "deutsch") Then
	str1 = "Verschiebe alle Dateien aller Unterordner des aktuellen Ordners: "
	str2 = "in eben diesen aktuellen Ordner?"&vbLF&"(Doppelte Dateien werden nummeriert)"&vbLF&vbLF&"Lösche Unterordner: "&bDelete_SubFolders
	str3 = "TC Unterordner aufräumen - Debug"
ELSE
	str1 = "Move all files from all sub folder of the current folder: "
	str2 = "up to that very current folder?"&vbLF&"(Dublicat files are numbered)"&vbLF&vbLF&"Delete sub folders: "&bDelete_SubFolders
	str3 = "TC Purge Folder - Debug"
End If '//strLanguageSprache = "Deutsch"

MB = MsgBox(str1&vbLF&vbLF&sStartFolder&vbLF&vbLF&str2,vbOKCancel+vbQuestion,str3) 
 If (MB = vbCancel) Then WScript.Quit 
'//=============================================================================
'//=============================================================================
'//============================================================================= THE CODE, DO NOT MODIFY
'//============================================================================= move files
RecurseFolders(sStartFolder)
Sub RecurseFolders(strFolder)
	Set oStartFolder = FSO.GetFolder(strFolder)
	For Each oFolder In oStartFolder.SubFolders
		strFolderToDel = oFolder.path
		'msgbox "fld " & oFolder.path
		For Each oFile In oFolder.Files
			iProcessedFilesCounter = iProcessedFilesCounter + 1
			iSerial = iDuplicateFilesSerial
			sFile = oFile.Name 
			If FSO.FileExists(sStartFolder & "\" & sFile) Then
				sBase = FSO.GetBaseName(sFile)
				sExte = FSO.GetExtensionName(sFile)
				Do While FSO.FileExists(sStartFolder & "\" & sBase & "_" & Pad(iSerial,iWantedPadding) & "." & sExte)
					iSerial = iSerial + 1
				Loop
				sFile = sBase & "_" & Pad(iSerial,iWantedPadding) & "." & sExte
				iSerial = iDuplicateFilesSerial '//back to wanted start digit
			End If
			If (oFile.path <> "") Then
				'StoreToLog oFile.path & vbTAB & sStartFolder & "\"& sFile,True
				StoreToLog oFile.path ,True
			End If
			FSO.MoveFile oFile.path, sStartFolder & "\" & sFile
		Next
		RecurseFolders oFolder.Path
	Next
End Sub 'RecurseFolders
StoreToLog Now() & ": " & "Moved " & iProcessedFilesCounter & " files:",False
'//============================================================================= delete sub folder
If iProcessedFilesCounter > 0 Then
	strDelFldLog=""
	ForEachFolder(sStartFolder)
End If
Sub ForEachFolder(strFolder)
	Set oStartFolder = FSO.GetFolder(strFolder)
	For Each oFolder In oStartFolder.SubFolders
		iProcessedFolderCounter = iProcessedFolderCounter + 1
		strDelFldLog=strDelFldLog & oFolder.path & vbCRLF
		'FSO.DeleteFolder( "FullFolderPath"[,force])
		FSO.DeleteFolder( oFolder.path )
	Next
End Sub 'ForEachFolder
StoreToLog vbCRLF&vbCRLF,True
StoreToLog Now() & ": " & "Deleted " & iProcessedFolderCounter & " folders:",True
StoreToLog strDelFldLog,True
'//============================================================================= write log file
WriteToLog(strLogText)
'//============================================================================= finishing // show log file
If bShowDebugLog Then
	If iProcessedFilesCounter > 0 Then
		WSO.run "notepad.exe " & strLogFile         
	ELSE
		MsgBox "Nothing found to move!"
	End If
End If
'//============================================================================= timestamp handler
Function Timestamp
	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)
	Timestamp = D & T 
End Function 'Timestamp
'//============================================================================= log file handler
Sub StoreToLog(strMSG, bAppend)
		If(bAppend) Then
			strLogText = strLogText & strMSG & vbCRLF
		ELSE
			strLogText = strMSG & vbCRLF & strLogText
		End IF
End Sub 'StoreToLog(strMSG, bAppend)
Sub WriteToLog(strMSG)
		Const ForAppending = 8
		Set FileOut = FSO.OpenTextFile(strLogFile,ForAppending,True)
		FileOut.Write(strMSG)
		FileOut.Close
End Sub 'WriteToLog(msg)
'//=============================================================================
Function Pad(iINT, iWantLen)
	If(iWantLen = 0) Then iWantLen = 1
	Pad = String( iWantLen-Len(iINT),"0") & iINT
End Function
'//=============================================================================
'//============================================================================= THIS IS THE END FRIEND









 
Inofficial FAQs || WIKI (Deu/Eng) || TC Home (What's new? // FAQ // Download // Order // Addons // Tools // Plugins)
Erst wenn der letzte Baum gefällt oder die letzte Biene verendet ist, werden die Leute verstehen warum Umweltschutz wichtig ist.

User avatar
HolgerK
Power Member
Power Member
Posts: 5141
Joined: 2006-01-26, 22:15 UTC
Location: Europe, Aachen

Re: [Solved] Dateien zusammenführen: Unterordner auflösen.

Post by *HolgerK » 2018-08-28, 12:29 UTC

<ot>
code" wrote:THIS IS THE END FRIEND
Auch ein Fan von "Jim Morrison, The Doors: The End "? :)

Gruss
Holger
</ot>
Make our planet great again

User avatar
Stefan2
Power Member
Power Member
Posts: 2640
Joined: 2007-09-13, 22:20 UTC
Location: Europa

Re: [Solved] Dateien zusammenführen: Unterordner auflösen.

Post by *Stefan2 » 2018-08-28, 13:45 UTC

<ot> Nicht im Speziellen, eher im Allgemeinen :D </ot>
Inofficial FAQs || WIKI (Deu/Eng) || TC Home (What's new? // FAQ // Download // Order // Addons // Tools // Plugins)
Erst wenn der letzte Baum gefällt oder die letzte Biene verendet ist, werden die Leute verstehen warum Umweltschutz wichtig ist.

Post Reply