mark-a17
Goto Top

Wie mit VBScript Dateien gleichmäßig in Unterordner verteilen?

Hallo,

ich versuche über mehrere Verzeichnisse Dateien gleichmäßig in Unterverzeichnisse aufzuteilen.

Die Dateisystemstruktur sieht im Ausgang so aus:

C:\Ordner1\OrdnerDatum\OrdnerObjekt\
ObjektDatei1
ObjektDatei2
ObjektDatei3
....
ObjektDatei 300


Unterhalb von .\OrdnerObjekt\ sollen nun wahlweise 3 - 4 Unterordner erstellt werden und
der Inhalt von .\OrdnerObjekt\ gleichmäßig auf diese Unterordner verteilt werden sortiert nach Dateiname:

C:\Ordner1\OrdnerDatum\OrdnerObjekt\OrdnerA\
ObjektDatei1
ObjektDatei2
ObjektDatei3
....
ObjektDatei 100

C:\Ordner1\OrdnerDatum\OrdnerObjekt\OrdnerB\
ObjektDatei101
ObjektDatei102
ObjektDatei103
....
ObjektDatei 200

C:\Ordner1\OrdnerDatum\OrdnerObjekt\OrdnerC\
ObjektDatei201
ObjektDatei202
ObjektDatei203
....
ObjektDatei 300


C:\Ordner1\OrdnerDatum\ wird über einen BrowseForFolder Dialog gewählt.

Danach soll das Script alle darin enthaltenen "OrdnerObjekt" Verzeichnisse durcharbeiten. Zur Zeit kommen die Namen dieser Verzeichnisse noch aus einer Textdatei, was auch nicht so ganz optimal ist.

Ich schaffe es zwar zunächst mal alle Dateien aus dem OrdnerObjekt in den festdefinierten Unterordner "a" zu verschieben, aber
dann komme ich nicht mehr weiter. Kann mir jemand helfen?

Hier mal meine bisherigen Bemühungen:


Grüße

Mark

Option Explicit

Dim CamFolder          ' CCDSoft Camera Objekt           
Dim Image              ' CCDSoft Image Objekt  
Dim fso                ' FileSystem Objekt  
Dim TxtFile            ' Textdatei target file  
Dim szPathToTargetFile ' Pfad zum target file  
Dim szTargetName       ' Objektname aus target file  
Dim dExposure2         ' Belichtungszeit aus target file  
Dim nSeries            ' Belichtungsserie aus target file  
Dim dRa, dDec          ' Koordinaten aus target file  
Dim imageFolder        ' Basis Ordner Bilder  
Dim tgtFolder          ' Zielobjektordner  
Dim strFolder          ' Gesamtpfad zu Objekt\RED  
Dim subFolder          ' Unterordner von RED: a,b,c  

Dim ForReading
Dim i
Dim Extension          ' Dateierweiterung  
Dim Paths
Dim Count
Dim f
Dim fcount              ' Anzahl der Dateien in einem Objektordner  
Dim scount             ' Anzahl der Dateien für einen Stack  

szPathToTargetFile = "C:\CCD\targets\Target.txt"  
imageFolder = "C:\CCD"  
ForReading = 1
Set CamFolder = CreateObject("CCDSoft.Folder")  
Set Image = CreateObject("CCDSoft.Image")  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set TxtFile = fso.OpenTextFile(szPathToTargetFile, ForReading)	

		Const WINDOW_HANDLE = 0
		Const OPTIONS = 0
		Dim objShell
		Dim objFolder
		Dim objFolderItem
		Dim objPath
		
		Set objShell = CreateObject("Shell.Application")  
		Set objFolder = objShell.BrowseForFolder _
		    (WINDOW_HANDLE, "Select a folder:", OPTIONS, "C:\")   
		
		If objFolder Is Nothing Then
		    Wscript.Quit
		End If
		
		Set objFolderItem = objFolder.Self
		objPath = objFolderItem.Path

On Error Resume Next		
Do While (TxtFile.AtEndOfStream <> True)
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec)
	 
	tgtFolder = "\" & RTrim(szTargetName)  
	strFolder = objPath & tgtFolder & "\RED"  
	
	'Set f = FSO.GetFolder(strFolder)  
	'fcount = f.Files.Count  
	'scount = fcount/3  
	
		CamFolder.Path = strFolder
		Paths = CamFolder.FilePathArray
		Count = UBound(Paths)
		For i=0 to Count
		Extension = Right(Paths(i), 4) 
		If ".FIT" = Extension Then  
			subFolder = strFolder & "\a\"  
			fso.MoveFile (Paths(i)), (subFolder)
		End if
		Next
Loop

TxtFile.Close
Set fso = Nothing
Set f = Nothing
Set Image = Nothing
Set CamFolder = Nothing

Sub GetDataFromTgtFile(LineFromFile, szTargetName, dExposure2, nSeries)
	szTargetName	= Mid(LineFromFile,1,15)
	dExposure2		= CDbl(Mid(LineFromFile,50,4))
	nSeries			= CDbl(Mid(LineFromFile,60,3))
End Sub
	

Content-Key: 166020

Url: https://administrator.de/contentid/166020

Ausgedruckt am: 28.03.2024 um 11:03 Uhr

Mitglied: bastla
bastla 11.05.2011 um 02:10:48 Uhr
Goto Top
Hallo mark-a17 und willkommen im Forum!

In gleicher epischer Breite, aber völlig ungetestet, meine Modifikation Deines Ansatzes:
Option Explicit

Dim CamFolder          ' CCDSoft Camera Objekt           
Dim Image              ' CCDSoft Image Objekt  
Dim fso                ' FileSystem Objekt  
Dim TxtFile            ' Textdatei target file  
Dim szPathToTargetFile ' Pfad zum target file  
Dim szTargetName       ' Objektname aus target file  
Dim dExposure2         ' Belichtungszeit aus target file  
Dim nSeries            ' Belichtungsserie aus target file  
Dim dRa, dDec          ' Koordinaten aus target file  
Dim imageFolder        ' Basis Ordner Bilder  
Dim tgtFolder          ' Zielobjektordner  
Dim strFolder          ' Gesamtpfad zu Objekt\RED  
Const NCOUNT = 3       ' Anzahl der zu erstellenden Unterordner  
Const FIRSTSUBFOLDER = "a" ' Buchstabe des ersten zu erstellenden Unterordners  
Dim arrSubFolder()     ' Array für Pfade der Unterordner  
Dim strSubFolderName   ' Unterordner von RED: a,b,c  
Dim strSubFolderPfad   ' Gesamtpfad zum Unterordner von RED  
Dim strFilePath        ' Pfad der zu verschiebenden Datei  

Const ForReading = 1
Dim i
Dim Extension          ' Dateierweiterung  
Const TOMOVE = "FIT" ' Dateierweiterung der zu verschiebenden Dateien in Großbuchstaben  
Dim Paths
Dim Count
Dim scount             ' Anzahl der Dateien für einen Stack  
Dim intIndexSubFolder  ' Index des aktuellen Unterordners  

szPathToTargetFile = "C:\CCD\targets\Target.txt"  
imageFolder = "C:\CCD"  
Set CamFolder = CreateObject("CCDSoft.Folder")  
Set Image = CreateObject("CCDSoft.Image")  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set TxtFile = fso.OpenTextFile(szPathToTargetFile, ForReading)	

Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell
Dim objFolder
Dim objFolderItem
Dim objPath
		
Set objShell = CreateObject("Shell.Application")  
Set objFolder = objShell.BrowseForFolder _
	(WINDOW_HANDLE, "Select a folder:", OPTIONS, "C:\")   
		
If objFolder Is Nothing Then
	WScript.Quit
End If
		
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path

'On Error Resume Next		  
Do While Not TxtFile.AtEndOfStream
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec)
	 
	tgtFolder = Trim(szTargetName)
	strFolder = objPath & "\" & tgtFolder & "\RED"  

	CamFolder.Path = strFolder
	Paths = CamFolder.FilePathArray
	Count = UBound(Paths)
	scount = Int(Count / NCOUNT + .99) 'auf Ganze aufgerundete Anzahl der Dateien je Unterordner  
	
	ReDim arrSubFolder(NCOUNT - 1) ' Array für Unterordnerpfade erstellen / löschen  
	For i = 0 To NCOUNT - 1 ' Unterordner erstellen und Gesamtpfade im Array speichern  
		strSubFolderName = Chr(Asc(FIRSTSUBFOLDER) + i) 'Buchstabe als Name des aktuellen Unterordners  
		strSubFolderPath = strFolder & "\" & strSubFolderName & "\"  
		If Not fso.FolderExists(strSubFolderPath) Then fso.CreateFolder(strSubFolderPath)
		arrSubFolder(i) = strSubFolderPath
	Next
	
	For i = 0 To UBound(Paths)
		intIndexSubFolder = i \ scount ' Unterordner-Index ermitteln  
		strFilePath = Paths(i) 'Pfad der aktuellen Datei  
		Extension = UCase(fso.GetExtensionName(strFilePath)) 'Dateierweiterung der aktuellen Datei in Großbuchstaben  
		If Extension = TOMOVE Then fso.MoveFile strFilePath, arrSubFolder(intIndexSubFolder) ' Datei in den entsprechenden Unterordner verschieben  
	Next
Loop

TxtFile.Close
Set fso = Nothing
Set f = Nothing
Set Image = Nothing
Set CamFolder = Nothing

Sub GetDataFromTgtFile(LineFromFile, szTargetName, dExposure2, nSeries)
	szTargetName	= Mid(LineFromFile,1,15)
	dExposure2	= CDbl(Mid(LineFromFile,50,4))
	nSeries		= CDbl(Mid(LineFromFile,60,3))
End Sub
Neben etwas Kosmetik und dem "Herausziehen" einiger bisher im Code versteckter Konstanten ist eigentlich nur das Verteilen auf die (mit Einzelbuchstaben benannten) Unterordner hinzugekommen - die Verwendung des Textfiles "C:\CCD\targets\Target.txt" habe ich noch beibehalten (vor allem, weil ich nicht wusste, was es mit "dExposure2" und "nSeries" auf sich hat - obwohl beide Werte nur ermittelt, aber nicht verwendet werden).

Wenn ich Dich richtig verstanden habe, könnte aber
Do While Not TxtFile.AtEndOfStream
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec)
	 
	tgtFolder = "\" & RTrim(szTargetName)  
	strFolder = objPath & tgtFolder & "\RED"  
	...
Loop
durch
For Each objSubFolder In fso.GetFolder(objPath).SubFolders
	strFolder = objSubFolder.Path & "\RED"  
	...
Next
ersetzt werden.
Ebenfalls nicht so ganz klar war mir das Ergebnis von
Paths = CamFolder.FilePathArray
- soferne, wie ich eigentlich vermute, damit alle im jeweiligen "\RED"-Ordner (übrigens auch noch ein Kandidat für eine Konstante) enthaltenen Dateien zurückgegeben werden, müsste die Anzahl der betroffenen "FIT"-Dateien (also "Count") eigentlich vorweg in einer Schleife der Art
Count = 0
For i = 0 To UBound(Paths)
    Extension = UCase(fso.GetExtensionName(strFilePath)) 'Dateierweiterung der aktuellen Datei in Großbuchstaben  
    If Extension = TOMOVE Then Count = Count + 1
Next
als Ersatz der Zeile 65 ermittelt werden, um tatsächlich eine gleiche Anzahl von Dateien je Unterordner zu erhalten.

[Edit]
Allerdings kann dann nicht
intIndexSubFolder = i \ scount
verwendet werden, sondern es muss anstelle von "i" ein eigener Zähler mitgeführt werden, der immer nur dann erhöht wird, wenn eine "FIT"-Datei verschoben wurde.
[/Edit]
Noch kurz zu
On Error Resume Next
Während der Testphase sollen doch Fehler erkennbar gemacht werden - daher habe ich die entsprechende Zeile auskommentiert; ob dann im produktiven Einsatz ein "Augen zu und durch" der richtige Ansatz ist, musst Du selbst beurteilen ...

Grüße
bastla

[Edit2] Zeile 70 (s. u.) korrigiert [/Edit2]
Mitglied: mark-a17
mark-a17 11.05.2011 um 10:46:37 Uhr
Goto Top
Hallo bastla,

viiielen Dank erstmal. Ich hätte meine Version vielleicht noch etwas mehr bereinigen müssen, denn das war nur ein Teil eines großen Skriptes wo mit den anderen Werten noch gearbeitet wird.
Ich nehme Deine Anregungen erst mal auf und versuchs zum laufen zu bringen. Ich vermute mal das intIndexOfSubFolder in Zeile 70 eigentlich intIndexSubFolder heißen soll.
Trotzdem läufts noch nicht ganz. Es wird nur der Ordner a erzeugt und alle Dateien auch wieder nach a geschoben.
Muss eventuell der Teil

Unterordner-Index ermitteln

vor dem Teil

Array für Unterordnerpfade erstellen

passieren ?

Ich muß mich noch etwas hineinvertiefen.

Vielen Dank erstmal. Bin um jeden weiteren Tipp dankbar.

Grüße

Mark
Mitglied: bastla
bastla 11.05.2011 um 10:52:50 Uhr
Goto Top
Hallo mark-a17!

Sorry - die Zeile 70 sollte richtig
strSubFolderName = Chr(Asc(FIRSTSUBFOLDER) + i) 'Buchstabe als Name des aktuellen Unterordners
lauten ("intIndexOfSubFolder" war ein Überbleibsel eines anderen Ansatzes) - ich korrigiere das auch oben ...

Grüße
bastla
Mitglied: mark-a17
mark-a17 11.05.2011 um 11:08:51 Uhr
Goto Top
Hallo bastla,

perfekt, das war's. Läuft wie geschmiert.

Vielen Dank, ich hoffe ich kann hier auch mal von Nutzen sein.

Mark