Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

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

Frage Entwicklung VB for Applications

Mitglied: mark-a17

mark-a17 (Level 1) - Jetzt verbinden

10.05.2011 um 23:11 Uhr, 5478 Aufrufe, 4 Kommentare

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

01.
Option Explicit 
02.
 
03.
Dim CamFolder          ' CCDSoft Camera Objekt          
04.
Dim Image              ' CCDSoft Image Objekt 
05.
Dim fso                ' FileSystem Objekt 
06.
Dim TxtFile            ' Textdatei target file 
07.
Dim szPathToTargetFile ' Pfad zum target file 
08.
Dim szTargetName       ' Objektname aus target file 
09.
Dim dExposure2         ' Belichtungszeit aus target file 
10.
Dim nSeries            ' Belichtungsserie aus target file 
11.
Dim dRa, dDec          ' Koordinaten aus target file 
12.
Dim imageFolder        ' Basis Ordner Bilder 
13.
Dim tgtFolder          ' Zielobjektordner 
14.
Dim strFolder          ' Gesamtpfad zu Objekt\RED 
15.
Dim subFolder          ' Unterordner von RED: a,b,c 
16.
 
17.
Dim ForReading 
18.
Dim i 
19.
Dim Extension          ' Dateierweiterung 
20.
Dim Paths 
21.
Dim Count 
22.
Dim f 
23.
Dim fcount              ' Anzahl der Dateien in einem Objektordner 
24.
Dim scount             ' Anzahl der Dateien für einen Stack 
25.
 
26.
szPathToTargetFile = "C:\CCD\targets\Target.txt" 
27.
imageFolder = "C:\CCD" 
28.
ForReading = 1 
29.
Set CamFolder = CreateObject("CCDSoft.Folder") 
30.
Set Image = CreateObject("CCDSoft.Image") 
31.
Set fso = CreateObject("Scripting.FileSystemObject") 
32.
Set TxtFile = fso.OpenTextFile(szPathToTargetFile, ForReading)	 
33.
 
34.
		Const WINDOW_HANDLE = 0 
35.
		Const OPTIONS = 0 
36.
		Dim objShell 
37.
		Dim objFolder 
38.
		Dim objFolderItem 
39.
		Dim objPath 
40.
		 
41.
		Set objShell = CreateObject("Shell.Application") 
42.
		Set objFolder = objShell.BrowseForFolder _ 
43.
		    (WINDOW_HANDLE, "Select a folder:", OPTIONS, "C:\")  
44.
		 
45.
		If objFolder Is Nothing Then 
46.
		    Wscript.Quit 
47.
		End If 
48.
		 
49.
		Set objFolderItem = objFolder.Self 
50.
		objPath = objFolderItem.Path 
51.
 
52.
On Error Resume Next		 
53.
Do While (TxtFile.AtEndOfStream <> True) 
54.
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec) 
55.
	  
56.
	tgtFolder = "\" & RTrim(szTargetName) 
57.
	strFolder = objPath & tgtFolder & "\RED" 
58.
	 
59.
	'Set f = FSO.GetFolder(strFolder) 
60.
	'fcount = f.Files.Count 
61.
	'scount = fcount/3 
62.
	 
63.
		CamFolder.Path = strFolder 
64.
		Paths = CamFolder.FilePathArray 
65.
		Count = UBound(Paths) 
66.
		For i=0 to Count 
67.
		Extension = Right(Paths(i), 4)  
68.
		If ".FIT" = Extension Then 
69.
			subFolder = strFolder & "\a\" 
70.
			fso.MoveFile (Paths(i)), (subFolder) 
71.
		End if 
72.
		Next 
73.
Loop 
74.
 
75.
TxtFile.Close 
76.
Set fso = Nothing 
77.
Set f = Nothing 
78.
Set Image = Nothing 
79.
Set CamFolder = Nothing 
80.
 
81.
Sub GetDataFromTgtFile(LineFromFile, szTargetName, dExposure2, nSeries) 
82.
	szTargetName	= Mid(LineFromFile,1,15) 
83.
	dExposure2		= CDbl(Mid(LineFromFile,50,4)) 
84.
	nSeries			= CDbl(Mid(LineFromFile,60,3)) 
85.
End Sub 
86.
	
Mitglied: bastla
11.05.2011 um 02:10 Uhr
Hallo mark-a17 und willkommen im Forum!

In gleicher epischer Breite, aber völlig ungetestet, meine Modifikation Deines Ansatzes:
01.
Option Explicit 
02.
 
03.
Dim CamFolder          ' CCDSoft Camera Objekt          
04.
Dim Image              ' CCDSoft Image Objekt 
05.
Dim fso                ' FileSystem Objekt 
06.
Dim TxtFile            ' Textdatei target file 
07.
Dim szPathToTargetFile ' Pfad zum target file 
08.
Dim szTargetName       ' Objektname aus target file 
09.
Dim dExposure2         ' Belichtungszeit aus target file 
10.
Dim nSeries            ' Belichtungsserie aus target file 
11.
Dim dRa, dDec          ' Koordinaten aus target file 
12.
Dim imageFolder        ' Basis Ordner Bilder 
13.
Dim tgtFolder          ' Zielobjektordner 
14.
Dim strFolder          ' Gesamtpfad zu Objekt\RED 
15.
Const NCOUNT = 3       ' Anzahl der zu erstellenden Unterordner 
16.
Const FIRSTSUBFOLDER = "a" ' Buchstabe des ersten zu erstellenden Unterordners 
17.
Dim arrSubFolder()     ' Array für Pfade der Unterordner 
18.
Dim strSubFolderName   ' Unterordner von RED: a,b,c 
19.
Dim strSubFolderPfad   ' Gesamtpfad zum Unterordner von RED 
20.
Dim strFilePath        ' Pfad der zu verschiebenden Datei 
21.
 
22.
Const ForReading = 1 
23.
Dim i 
24.
Dim Extension          ' Dateierweiterung 
25.
Const TOMOVE = "FIT" ' Dateierweiterung der zu verschiebenden Dateien in Großbuchstaben 
26.
Dim Paths 
27.
Dim Count 
28.
Dim scount             ' Anzahl der Dateien für einen Stack 
29.
Dim intIndexSubFolder  ' Index des aktuellen Unterordners 
30.
 
31.
szPathToTargetFile = "C:\CCD\targets\Target.txt" 
32.
imageFolder = "C:\CCD" 
33.
Set CamFolder = CreateObject("CCDSoft.Folder") 
34.
Set Image = CreateObject("CCDSoft.Image") 
35.
Set fso = CreateObject("Scripting.FileSystemObject") 
36.
Set TxtFile = fso.OpenTextFile(szPathToTargetFile, ForReading)	 
37.
 
38.
Const WINDOW_HANDLE = 0 
39.
Const OPTIONS = 0 
40.
Dim objShell 
41.
Dim objFolder 
42.
Dim objFolderItem 
43.
Dim objPath 
44.
		 
45.
Set objShell = CreateObject("Shell.Application") 
46.
Set objFolder = objShell.BrowseForFolder _ 
47.
	(WINDOW_HANDLE, "Select a folder:", OPTIONS, "C:\")  
48.
		 
49.
If objFolder Is Nothing Then 
50.
	WScript.Quit 
51.
End If 
52.
		 
53.
Set objFolderItem = objFolder.Self 
54.
objPath = objFolderItem.Path 
55.
 
56.
'On Error Resume Next		 
57.
Do While Not TxtFile.AtEndOfStream 
58.
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec) 
59.
	  
60.
	tgtFolder = Trim(szTargetName) 
61.
	strFolder = objPath & "\" & tgtFolder & "\RED" 
62.
 
63.
	CamFolder.Path = strFolder 
64.
	Paths = CamFolder.FilePathArray 
65.
	Count = UBound(Paths) 
66.
	scount = Int(Count / NCOUNT + .99) 'auf Ganze aufgerundete Anzahl der Dateien je Unterordner 
67.
	 
68.
	ReDim arrSubFolder(NCOUNT - 1) ' Array für Unterordnerpfade erstellen / löschen 
69.
	For i = 0 To NCOUNT - 1 ' Unterordner erstellen und Gesamtpfade im Array speichern 
70.
		strSubFolderName = Chr(Asc(FIRSTSUBFOLDER) + i) 'Buchstabe als Name des aktuellen Unterordners 
71.
		strSubFolderPath = strFolder & "\" & strSubFolderName & "\" 
72.
		If Not fso.FolderExists(strSubFolderPath) Then fso.CreateFolder(strSubFolderPath) 
73.
		arrSubFolder(i) = strSubFolderPath 
74.
	Next 
75.
	 
76.
	For i = 0 To UBound(Paths) 
77.
		intIndexSubFolder = i \ scount ' Unterordner-Index ermitteln 
78.
		strFilePath = Paths(i) 'Pfad der aktuellen Datei 
79.
		Extension = UCase(fso.GetExtensionName(strFilePath)) 'Dateierweiterung der aktuellen Datei in Großbuchstaben 
80.
		If Extension = TOMOVE Then fso.MoveFile strFilePath, arrSubFolder(intIndexSubFolder) ' Datei in den entsprechenden Unterordner verschieben 
81.
	Next 
82.
Loop 
83.
 
84.
TxtFile.Close 
85.
Set fso = Nothing 
86.
Set f = Nothing 
87.
Set Image = Nothing 
88.
Set CamFolder = Nothing 
89.
 
90.
Sub GetDataFromTgtFile(LineFromFile, szTargetName, dExposure2, nSeries) 
91.
	szTargetName	= Mid(LineFromFile,1,15) 
92.
	dExposure2	= CDbl(Mid(LineFromFile,50,4)) 
93.
	nSeries		= CDbl(Mid(LineFromFile,60,3)) 
94.
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
01.
Do While Not TxtFile.AtEndOfStream 
02.
	Call GetDataFromTgtFile(TxtFile.ReadLine, szTargetName, dRa, dDec) 
03.
	  
04.
	tgtFolder = "\" & RTrim(szTargetName) 
05.
	strFolder = objPath & tgtFolder & "\RED" 
06.
	... 
07.
Loop
durch
01.
For Each objSubFolder In fso.GetFolder(objPath).SubFolders 
02.
	strFolder = objSubFolder.Path & "\RED" 
03.
	... 
04.
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
01.
Count = 0 
02.
For i = 0 To UBound(Paths) 
03.
    Extension = UCase(fso.GetExtensionName(strFilePath)) 'Dateierweiterung der aktuellen Datei in Großbuchstaben 
04.
    If Extension = TOMOVE Then Count = Count + 1 
05.
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]
Bitte warten ..
Mitglied: mark-a17
11.05.2011 um 10:46 Uhr
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
Bitte warten ..
Mitglied: bastla
11.05.2011 um 10:52 Uhr
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
Bitte warten ..
Mitglied: mark-a17
11.05.2011 um 11:08 Uhr
Hallo bastla,

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

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

Mark
Bitte warten ..
Neuester Wissensbeitrag
Microsoft

Lizenzwiederverkauf und seine Tücken

(5)

Erfahrungsbericht von DerWoWusste zum Thema Microsoft ...

Ähnliche Inhalte
Batch & Shell
Ordner inkl. Unterordner nach Dateien überprüfen (4)

Frage von belfry zum Thema Batch & Shell ...

Batch & Shell
gelöst Dateien mit Teil des Dateinamen per Batch in Unterordner verschieben (14)

Frage von smitternacht zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Netzwerk
Windows 10 RDP geht nicht (16)

Frage von Fiasko zum Thema Windows Netzwerk ...

Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

Microsoft Office
Keine Updates für Office 2016 (13)

Frage von Motte990 zum Thema Microsoft Office ...