Frage Entwicklung VB for Applications
gelöst Hta und Vbscript - Dateien mit Array filtern - automatisch umbenennen und bei bestimmten Dateien eine Nummerierung dem Dateinamen hinzufügen

06.10.2011, aktualisiert 14.10.2011, 4251 Aufrufe, 16 Kommentare

In einem Ordner befinden sich gepackte Dateien im zip,tar und rar Format. Der Ordner wird auf Vorhandensein dieser Formate abgefragt und wenn ja werden die Dateinamen in eine Textdatei geschrieben.
Diese wird ausgelesen und eine Listbox in der HTA wird damit gefüllt.
Danach ist eine mehrfach Selektion der Dateien welche man entpacken will , möglich.

Hat man dann seine Wahl getroffen und die Dateien sind entpackt sollen diese mittels eines Arrays , das auf bestimmte Dateiendungen abfragt, gefiltert werden.
Danach sollen die entpackten Dateien den Namen der gepackten Datei erhalten (ohne Endung) und die Endung der entpackten Datei.
Meistens enthält eine gepackte Datei nur 1 Datei,wenn doch mal 2 oder mehr vorhanden sind,sollen diese automatisch eine Nummerierung erhalten.

Beispiel einzelne Datei:

Name der gepackten Datei

Abteilung Lohnbuchhaltung.zip

Name der entpackten Datei

müller.xls

daraus soll dann werden

Abteilung Lohnbuchhaltung.xls

Beispiel mehrere Dateien:

Name der gepackten Datei

Abteilung Lagerhaltung.zip

Name der entpackten Dateien

maier test-a.xls
maier test-b.xls

daraus soll dann werden

Abteilung Lagerhaltung - 1.xls
Abteilung Lagerhaltung - 2.xls

Bis hierhin funktioniert meine Hta mit Vbscript schon. Die automatische Umbenennung funktioniert nur bei gepackten Dateien die 1 Datei enthalten (hiervon kann ich auch mehrere auswählen).
Sobald aber eine Kombination von gepackten Dateien ausgewählt wird (die 1 und 2 Dateien beeinhalten) funktioniert die automatische Nummerierung nicht mehr.
Ich finde den Fehler einfach nicht und wollte fragen ob mir hierbei jemand bitte helfen könnte.

Hier der Code für die Umbenennung und Nummerierung:

moveordner = Ordner in dem die Dateien entpackt werden
zielfolder = Hier werden die umbenannten Dateien hin verschoben
sTyp = Dateiendungen
aTypen= Array ("xls", "doc") usw,,,,
objitem.value = Name der gepackten Datei,ausgelesen aus der Textdatei (für die Listbox)

For Each sTyp In aTypen 'Dateitypen
    For Each oFile In fso.GetFolder(moveordner).Files 'Quelldateien
          If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
oname = Left(objitem.value, InStrRev(objitem.value, ".") - 1)
ofile_endung = Right(ofile.name, 3)
ofile.name = oname & "." & ofile_endung 
 


if not objfso.FileExists(zielfolder & "\" & ofile.name) and not ofilecounter > 1 then

	msgbox "Datei wird in zielfolder verschoben"
	ofile.Move zielfolder
	ofilecounter = ofilecounter + 1

	
if not (movefolder & "\" & oname) = (zielfolder & "\" & oname) then
ofilecounter = 0

end if
end if

if ofilecounter = 2 then
	msgbox "Dateiverarbeitung von mehreren Dateien"
	k = k + 1
	fz = " - Teil " & (k)
	ofile.name = oname & fz & "." & ofile_endung
else
msgbox "Datei  " & ofile.name & "  wird in den Zielfolder verschoben"
ofile.move zielfolder
ofilecounter = 0

end if
end if		

next
next



'###################################################################################################
'
'                          Alle verbliebenen Dateien im moveordner löschen
'
'###################################################################################################


Set objFolder = objFSO.GetFolder(moveordner)
For each dFile in objFolder.Files

		dFile.Delete

next
End If
Next01.

02.
For Each sTyp In aTypen 'Dateitypen
03.
    For Each oFile In fso.GetFolder(moveordner).Files 'Quelldateien
04.
          If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
05.
oname = Left(objitem.value, InStrRev(objitem.value, ".") - 1)
06.
ofile_endung = Right(ofile.name, 3)
07.
ofile.name = oname & "." & ofile_endung 
08.
 
09.

10.

11.
if not objfso.FileExists(zielfolder & "\" & ofile.name) and not ofilecounter > 1 then
12.

13.
	msgbox "Datei wird in zielfolder verschoben"
14.
	ofile.Move zielfolder
15.
	ofilecounter = ofilecounter + 1
16.

17.
	
18.
if not (movefolder & "\" & oname) = (zielfolder & "\" & oname) then
19.
ofilecounter = 0
20.

21.
end if
22.
end if
23.

24.
if ofilecounter = 2 then
25.
	msgbox "Dateiverarbeitung von mehreren Dateien"
26.
	k = k + 1
27.
	fz = " - Teil " & (k)
28.
	ofile.name = oname & fz & "." & ofile_endung
29.
else
30.
msgbox "Datei  " & ofile.name & "  wird in den Zielfolder verschoben"
31.
ofile.move zielfolder
32.
ofilecounter = 0
33.

34.
end if
35.
end if		
36.

37.
next
38.
next
39.

40.

41.

42.
'###################################################################################################
43.
'
44.
'                          Alle verbliebenen Dateien im moveordner löschen
45.
'
46.
'###################################################################################################
47.

48.

49.
Set objFolder = objFSO.GetFolder(moveordner)
50.
For each dFile in objFolder.Files
51.

52.
		dFile.Delete
53.

54.
next
55.
End If
56.
Next

Vielen Dank für eure Hilfe
Sollte der komplette Code benötigt werden,bitte ich um kurze Antwort hier und ich werde dann mein Posting editieren.

Gruß
Claus

16 Antworten

LÖSUNG bastla schreibt am 06.10.2011 um 15:32:58 Uhr
- LÖSUNG cbli schreibt am 06.10.2011 um 15:57:52 Uhr
  - LÖSUNG bastla schreibt am 06.10.2011 um 16:21:17 Uhr
    - LÖSUNG cbli schreibt am 07.10.2011 um 12:34:49 Uhr
      - LÖSUNG bastla schreibt am 07.10.2011 um 15:11:58 Uhr
        
        LÖSUNG cbli schreibt am 07.10.2011 um 16:45:38 Uhr
        
        LÖSUNG bastla schreibt am 07.10.2011 um 17:26:03 Uhr
        
        LÖSUNG cbli schreibt am 07.10.2011 um 19:15:26 Uhr
        
        LÖSUNG bastla schreibt am 07.10.2011 um 19:29:47 Uhr
        
        LÖSUNG cbli schreibt am 08.10.2011 um 00:54:35 Uhr
        
        LÖSUNG cbli schreibt am 14.10.2011 um 12:46:16 Uhr
        
        LÖSUNG bastla schreibt am 14.10.2011 um 15:13:00 Uhr
        
        LÖSUNG cbli schreibt am 14.10.2011 um 16:17:36 Uhr
        
        LÖSUNG bastla schreibt am 14.10.2011 um 16:31:17 Uhr
        
        LÖSUNG cbli schreibt am 14.10.2011 um 18:26:59 Uhr
        
        LÖSUNG cbli schreibt am 24.10.2011 um 23:56:21 Uhr

bastla (Level 5) - Jetzt verbinden

LÖSUNG 06.10.2011 um 15:32 Uhr

Hallo cbli!

Abgesehen davon, dass ich vernünftige Einrückungen und als Zeilen 5 und 6 eher

oname = fso.GetBaseName(objitem.Value)
ofile_Endung = fso.GetExtensionName(ofile.name)01.
oname = fso.GetBaseName(objitem.Value)
02.
ofile_Endung = fso.GetExtensionName(ofile.name)

verwenden würde: Wie erfolgt (da ja mehrere Dateien entpackt werden können) die Zuordnung zur Archivdatei oder ist davon auszugehen, dass sich in "moveordner" jeweils nur die Dateien eines Archivs befinden?

Grüße
bastla

cbli (Level 1) - Jetzt verbinden

LÖSUNG 06.10.2011 um 15:57 Uhr

Hallo bastla

Danke für den Hinweis zu Zeilen 5 + 6

Die ganze Zuordnung erfolgt in einer for Schleife in der obiger Code Ausschnitt auch enthalten ist.
Während eines Schleifendurchlaufs wird immer nur 1 Archiv verarbeitet und im moveordner befinden sich immer nur die entpackten Dateien aus 1 Archiv (also 1 oder mehrere - je nach Inhalt des Archivs).

Gruß
Claus

bastla (Level 5) - Jetzt verbinden

LÖSUNG 06.10.2011 um 16:21 Uhr

Hallo cbli!

Soferne nicht geprüft werden muss, ob es eine gleichnamige Zieldatei (aus einem früheren Entpackungsvorgang) bereits gibt, würde ich das etwa so versuchen:

oname = fso.GetBaseName(objitem.Value)

For Each sTyp In aTypen 'Dateitypen
    ofilecounter = 0
    For Each oFile In fso.GetFolder(moveordner).Files 'Quelldateien
        If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
            ofilecounter = ofilecounter + 1
            ofile_Endung = fso.GetExtensionName(oFile.Path) 'nur erforderlich, wenn Groß-/Kleinschreibung des Typs "original" übernommen werden soll - ansonsten würde sTyp ohnehin bereits zur Verfügung stehen
            oFile.Name = oname & " - " & ofilecounter & "." & ofile_Endung 'jede Datei umbenennen und mit lfd Nummer versehen
        End If
    Next
    If ofilecounter > 0 Then 'Wenn es Dateien des untersuchten Typs gab ...
        fso.MoveFile moveordner & "\" & oname & "*." & sTyp, zielordner '... alle auf einmal verschieben
        If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
            fso.GetFile(zielordner & "\" & oname & " - 1." & sTyp).Name = oname & "." & sTyp '... die Laufnummer (" - 1") wieder entfernen
            WScript.Echo "1 " & sTyp & "-Datei wurde in zielordner verschoben"
        Else
            WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielordner verschoben"	
        End If
    End If
Next

'###################################################################################################
'
'                          Alle verbliebenen Dateien im moveordner löschen
'
'###################################################################################################
Set objFolder = fso.GetFolder(moveordner)
For Each dFile In objFolder.Files
    dFile.Delete
Next01.
oname = fso.GetBaseName(objitem.Value)
02.

03.
For Each sTyp In aTypen 'Dateitypen
04.
    ofilecounter = 0
05.
    For Each oFile In fso.GetFolder(moveordner).Files 'Quelldateien
06.
        If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
07.
            ofilecounter = ofilecounter + 1
08.
            ofile_Endung = fso.GetExtensionName(oFile.Path) 'nur erforderlich, wenn Groß-/Kleinschreibung des Typs "original" übernommen werden soll - ansonsten würde sTyp ohnehin bereits zur Verfügung stehen
09.
            oFile.Name = oname & " - " & ofilecounter & "." & ofile_Endung 'jede Datei umbenennen und mit lfd Nummer versehen
10.
        End If
11.
    Next
12.
    If ofilecounter > 0 Then 'Wenn es Dateien des untersuchten Typs gab ...
13.
        fso.MoveFile moveordner & "\" & oname & "*." & sTyp, zielordner '... alle auf einmal verschieben
14.
        If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
15.
            fso.GetFile(zielordner & "\" & oname & " - 1." & sTyp).Name = oname & "." & sTyp '... die Laufnummer (" - 1") wieder entfernen
16.
            WScript.Echo "1 " & sTyp & "-Datei wurde in zielordner verschoben"
17.
        Else
18.
            WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielordner verschoben"	
19.
        End If
20.
    End If
21.
Next
22.

23.
'###################################################################################################
24.
'
25.
'                          Alle verbliebenen Dateien im moveordner löschen
26.
'
27.
'###################################################################################################
28.
Set objFolder = fso.GetFolder(moveordner)
29.
For Each dFile In objFolder.Files
30.
    dFile.Delete
31.
Next

Es wäre natürlich auch möglich, wenn es nur eine Datei gibt, diese bereits vor dem Verschieben vom Zusatz " - 1" zu befreien; das nachträgliche Umbenennen habe ich wegen der Ausgabe (für die ich ansonsten nochmals eine Unterscheidung zwischen 1 und mehreren Dateien benötigt hätte) erst im "zielfolder" durchgeführt ...

Grüße
bastla

[Edit] Fehlenden "." in Zeile 15 hinzugefügt und "zielordner" korrigiert[/Edit]

cbli (Level 1) - Jetzt verbinden

LÖSUNG 07.10.2011 um 12:34 Uhr

Hallo bastla

Ersteinmal vielen Dank für deine Bemühungen !
Habe jetzt deinen Code Schnipsel getestet und es funktioniert zuverlässig mit Archiven die 2 oder mehr Dateien enthalten.
Ist im Archiv nur 1 Datei, wird die Laufnummer nicht entfernt.

Außerdem habe ich jetzt leider feststellen müssen,daß in meinen Archiven auch noch andere Konstellationen vorkommen können.

Beispiel:

Name der gepackten Datei

Abteilung Lohnbuchhaltung.zip

Namen der entpackten Dateien

müller.xls
müller.doc
müller.pub

daraus soll dann werden

Abteilung Lohnbuchhaltung.xls
Abteilung Lohnbuchhaltung.doc
Abteilung Lohnbuchhaltung.pub

Beispiel 2:

Name der gepackten Datei

Abteilung Lagerhaltung.zip

Namen der entpackten Dateien

müller a.xls
müller a.doc
müller a.pub

müller b.xls
müller b.doc
müller b.pub

daraus soll dann werden

Abteilung Lagerhaltung 1.xls
Abteilung Lagerhaltung 1.doc
Abteilung Lagerhaltung 1.pub

Abteilung Lagerhaltung 2.xls
Abteilung Lagerhaltung 2.doc
Abteilung Lagerhaltung 2.pub

Kann man das noch irgendwie miteinbauen in den Code ?

Noch 2 Verständnisfragen hätte ich

1. Kann man bei einem Move Befehl irgendwie erreichen,daß eine bereits vorhandene Datei überschrieben wird ?

Habe es seither mit Copy und dann Delete gemacht, Ist aber sehr umständlich

2. Gibt es eine Möglichkeit in einer Hta mit Vbscript ein Popup oder msgbox Fenster (das eine Variable enthält) automatisch nach einer bestimmten Zeit schließen zu lassen ?

Vielen Dank schon mal im Vorraus

Gruß
Claus

bastla (Level 5) - Jetzt verbinden

LÖSUNG 07.10.2011 um 15:11 Uhr

Hallo cbli!

Nur mal kurz zum Fehler bei Einzeldateien - in Zeile 15 fehlte noch ein "." (ist inzwischen ergänzt) ...

CreateObject("WScript.Shell").PopUp ...

funktioniert, müsstest Du testen ...

Grüße
bastla

cbli (Level 1) - Jetzt verbinden

LÖSUNG 07.10.2011 um 16:45 Uhr

Hallo bastla

Hab deine Ergänzung gerade nochmal getestet und bin jetzt etwas verwirrt.
Viele Archive die 1 Datei enthalten macht er, manche aber nicht obwohl ja der Dateiname keine Rolle spielen dürfte.

Beispiel 1 aus meinem letzten Beitrag macht er auch nicht.

Beispiel 2 jedoch ohne Probleme ,sowie auch alle anderen Archive die 2 oder mehr Dateien enthalten.

Woran kann das liegen ?

CreateObject("WScript.Shell").PopUp ...

Teste ich gerade.....

edit: Hat leider nicht funktioniert,außer ich lasse den Mauszeiger für die eingestellte Zeit auf dem Popup Fenster ruhen - Fällt dir da was ein ?

Wäre nett wenn du nochmal drüberschauen könntest..

Danke + lieben Gruß
Claus

bastla (Level 5) - Jetzt verbinden

LÖSUNG 07.10.2011 um 17:26 Uhr

Hallo cbli!

Da die Files-Auflistung die umbenannten Dateien im Quellordner ein zweites Mal erfasst, eine etwas abgewandelte Vorgangsweise:

If Right(zielordner, 1) <> "\" Then zielordner = zielordner & "\"
For Each sTyp In aTypen 'Dateitypen
    ofilecounter = 0
    For Each oFile In fso.GetFolder(moveordner).Files 'Quelldateien
        If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
            ofilecounter = ofilecounter + 1
            oFile.Name = oname & " - " & ofilecounter & "." & sTyp 'jede Datei umbenennen und mit lfd Nummer versehen und ...
            oFile.Move zielordner '... gleich verschieben
        End If
    Next
    If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
        fso.GetFile(zielordner & oname & " - 1." & sTyp).Name = oname & "." & sTyp '... die Laufnummer (" - 1") wieder entfernen
        WScript.Echo "1 " & sTyp & "-Datei wurde in zielfolder verschoben"
    ElseIf ofilecounter > 1 Then
        WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielfolder verschoben"
    End If
Next01.
If Right(zielordner, 1) <> "\" Then zielordner = zielordner & "\"
02.
For Each sTyp In aTypen 'Dateitypen
03.
    ofilecounter = 0
04.
    For Each oFile In fso.GetFolder(moveordner).Files 'Quelldateien
05.
        If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
06.
            ofilecounter = ofilecounter + 1
07.
            oFile.Name = oname & " - " & ofilecounter & "." & sTyp 'jede Datei umbenennen und mit lfd Nummer versehen und ...
08.
            oFile.Move zielordner '... gleich verschieben
09.
        End If
10.
    Next
11.
    If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
12.
        fso.GetFile(zielordner & oname & " - 1." & sTyp).Name = oname & "." & sTyp '... die Laufnummer (" - 1") wieder entfernen
13.
        WScript.Echo "1 " & sTyp & "-Datei wurde in zielfolder verschoben"
14.
    ElseIf ofilecounter > 1 Then
15.
        WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielfolder verschoben"
16.
    End If
17.
Next

Kann man bei einem Move Befehl irgendwie erreichen,daß eine bereits vorhandene Datei überschrieben wird ?

Nein; ein "Move" oder "MoveFile" kann existierende Zieldateien nicht überschreiben.

Grüße
bastla

cbli (Level 1) - Jetzt verbinden

LÖSUNG 07.10.2011 um 19:15 Uhr

Hallo bastla

Danke ! Danke ! Danke !

Teste jetzt seit 1 Stunde und habe noch keinen Fehler gefunden.
Alles wird wunderbar umbenannt, egal ob 1 Datei im Archiv ist oder auch mehrere.
Ich habe jetzt jedoch eine noch weit genug reichende Abfrage meinerseits entdeckt (an einer anderen Stelle in meinem Script) und vielleicht kannst du mir noch einen Tip geben.

For Each sTyp In aTypen 'Dateitypen
	For Each sampleFile In fso.GetFolder(moveordner).Files 'Quelldateien
		if right(sampleFile.name, 10)="sample.doc" or left(sampleFile.name, 6)="sample" then 
			sampleFile.Delete
		end if
	next
next01.
For Each sTyp In aTypen 'Dateitypen
02.
	For Each sampleFile In fso.GetFolder(moveordner).Files 'Quelldateien
03.
		if right(sampleFile.name, 10)="sample.doc" or left(sampleFile.name, 6)="sample" then 
04.
			sampleFile.Delete
05.
		end if
06.
	next
07.
next

Mit diesem Code lösche ich vor der eigentlichen Umbenennung der entpackten Dateien,etwaige unerwünschte Dateien.
In diesem Beispiel löscht er alle Dateien die entweder sample????.doc oder ?????sample.doc heißen.
Ich hatte es nur mit der Endung doc probiert und da es funktioniert hat, habe ich es vergessen.
Es können jedoch auch alle anderen Dateiendungen (die im Array hinterlegt sind) vorkommen ,die manchmal nur 2 Stellen oder auch 4 Stellen (xlsx,docx,usw....) haben und dann würde es ja nicht mehr funktionieren mit meinem obigen Code
Wie muss ich das entsprechend erweitern,daß der Code flexibler ist und ich alle Dateiendungen ,egal welcher Länge, verarbeiten kann ?

Nochmals Dank und schon mal vorab ein wunderschönes Wochenende

Gruß
Claus

bastla (Level 5) - Jetzt verbinden

LÖSUNG 07.10.2011 um 19:29 Uhr

Hallo cbli!

Du kannst ja die gleiche Vorgangsweise wie oben wählen, um nur die "sTyp"-Dateien zu verarbeiten und dann nur den Dateinamen prüfen:

CheckFor = "sample"
LCheckFor = Len(CheckFor) 'Länge nur ein einziges Mal ermitteln

For Each sTyp In aTypen 'Dateitypen
    For Each sampleFile In fso.GetFolder(moveordner).Files 'Quelldateien
        If LCase(fso.GetExtensionName(sampleFile.Path)) = sTyp Then
            sampleFileName = LCase(fso.GetBaseName(sampleFile.Path))
            If Right(sampleFileName, LCheckFor) = CheckFor Or Left(sampleFileName, LCheckFor) = CheckFor Then sampleFile.Delete
        End If
    Next
Next01.
CheckFor = "sample"
02.
LCheckFor = Len(CheckFor) 'Länge nur ein einziges Mal ermitteln
03.

04.
For Each sTyp In aTypen 'Dateitypen
05.
    For Each sampleFile In fso.GetFolder(moveordner).Files 'Quelldateien
06.
        If LCase(fso.GetExtensionName(sampleFile.Path)) = sTyp Then
07.
            sampleFileName = LCase(fso.GetBaseName(sampleFile.Path))
08.
            If Right(sampleFileName, LCheckFor) = CheckFor Or Left(sampleFileName, LCheckFor) = CheckFor Then sampleFile.Delete
09.
        End If
10.
    Next
11.
Next

Noch einfacher wäre es natürlich, wenn nur das Vorhandensein von "sample" im Dateinamen geprüft werden müsste - dann würde "InStr()" reichen ...

Grüße
bastla

cbli (Level 1) - Jetzt verbinden

LÖSUNG 08.10.2011 um 00:54 Uhr

Hallo bastla

Vielen Dank für den letzten Code Schnipsel ! Hat perfekt funktioniert.
Tatsächlich hätte für obigen Code "InStr()" gereicht,da ja schon vorher auf Dateiendungen gefiltert wurde.
Habs aber leider zu spät bemerkt,du warst einfach zu schnell !
Allerdings kann ich deine Lösung für ein anderes Script brauchen,das demnächst geplant ist.
Nochmals Dank für deine grandiose Hilfe.
ich werde den Beitrag als gelöst markieren.

Gruß
Claus

cbli (Level 1) - Jetzt verbinden

LÖSUNG 14.10.2011 um 12:46 Uhr

Hallo

Erstmal Sorry,daß ich hier nochmals schreibe, aber mir ist ist nach langem Testen noch aufgefallen,daß ich vergessen hatte die Funktion einzubauen,die prüft ob eine zu entpackende
Datei im Zielordner schon existiert.
Befindet sich 1 Datei im Archiv funktioniert der Code den ich hinzugefügt habe.
Jedoch nicht bei 2 oder mehr Dateien in einem Archiv.

Wäre nett wenn jemand nochmal drüberschauen könnte und mir sagen was ich falsch gemacht habe. Ich komme einfach nicht drauf.

'###################################################################################################
'             Dateien umbenennen,nummerieren und in Zielordner verschieben
'###################################################################################################


oname = fso.GetBaseName(objitem.Value)
 
	If Right(zielfolder, 1) <> "\" Then zielfolder = zielfolder & "\"
	For Each sTyp In aTypen 'Dateitypen
    
	ofilecounter = 0
    
		For Each oFile In fso.GetFolder(moveordner).Files 							'Quelldateien
        
			If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
            
			ofilecounter = ofilecounter + 1
			ofile.Name = oname & "." & sTyp 		

				If fso.FileExists(zielfolder & "\" & oFile.Name) Then 'Zieldatei
					
					Set oFileZiel = fso.GetFile(zielfolder & "\" & oFile.Name)

                			                                      If oFileZiel.Size >= oFile.Size Then 
							ofile.Delete
					else	
					
							ofileZiel.Delete
							ofile.move moveordner
					end if
				end if

			oFile.Name = oname & " - cd" & ofilecounter & "." & sTyp 					'jede Datei umbenennen und mit lfd Nummer versehen und ...
            
			msgbox ofile.name
			oFile.Move zielfolder
			 
			End If
    
		Next
    
				If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
        
				fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Name = oname & "." & sTyp 		'... die Laufnummer (" - 1") wieder entfernen
        
				WScript.Echo "1 " & sTyp & "-Datei wurde in zielfolder verschoben"
    
				ElseIf ofilecounter > 1 Then
        
				WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielfolder verschoben"
    
				End If
	Next
	

'###################################################################################################
'
'           Alle verbliebenen Dateien im moveordner löschen
'
'###################################################################################################



Set objFolder = fso.GetFolder(moveordner)

	For Each dFile In objFolder.Files
    
	dFile.Delete

Next

	End If
	Next
end sub01.

02.
'###################################################################################################
03.
'             Dateien umbenennen,nummerieren und in Zielordner verschieben
04.
'###################################################################################################
05.

06.

07.
oname = fso.GetBaseName(objitem.Value)
08.
 
09.
	If Right(zielfolder, 1) <> "\" Then zielfolder = zielfolder & "\"
10.
	For Each sTyp In aTypen 'Dateitypen
11.
    
12.
	ofilecounter = 0
13.
    
14.
		For Each oFile In fso.GetFolder(moveordner).Files 							'Quelldateien
15.
        
16.
			If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
17.
            
18.
			ofilecounter = ofilecounter + 1
19.
			ofile.Name = oname & "." & sTyp 		
20.

21.
				If fso.FileExists(zielfolder & "\" & oFile.Name) Then 'Zieldatei
22.
					
23.
					Set oFileZiel = fso.GetFile(zielfolder & "\" & oFile.Name)
24.

25.
                			                                      If oFileZiel.Size >= oFile.Size Then 
26.
							ofile.Delete
27.
					else	
28.
					
29.
							ofileZiel.Delete
30.
							ofile.move moveordner
31.
					end if
32.
				end if
33.

34.
			oFile.Name = oname & " - cd" & ofilecounter & "." & sTyp 					'jede Datei umbenennen und mit lfd Nummer versehen und ...
35.
            
36.
			msgbox ofile.name
37.
			oFile.Move zielfolder
38.
			 
39.
			End If
40.
    
41.
		Next
42.
    
43.
				If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
44.
        
45.
				fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Name = oname & "." & sTyp 		'... die Laufnummer (" - 1") wieder entfernen
46.
        
47.
				WScript.Echo "1 " & sTyp & "-Datei wurde in zielfolder verschoben"
48.
    
49.
				ElseIf ofilecounter > 1 Then
50.
        
51.
				WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielfolder verschoben"
52.
    
53.
				End If
54.
	Next
55.
	
56.

57.
'###################################################################################################
58.
'
59.
'           Alle verbliebenen Dateien im moveordner löschen
60.
'
61.
'###################################################################################################
62.

63.

64.

65.
Set objFolder = fso.GetFolder(moveordner)
66.

67.
	For Each dFile In objFolder.Files
68.
    
69.
	dFile.Delete
70.

71.
Next
72.

73.
	End If
74.
	Next
75.
end sub

Vielen Dank schon mal

Gruß
Claus

bastla (Level 5) - Jetzt verbinden

LÖSUNG 14.10.2011 um 15:13 Uhr

Hallo cbli!

Vielleicht beschreibst Du nochmals, wie die veränderte Zielsetzung lautet ...

Dein Ansatz versucht in den Zeilen 34 - 37, eine ev bereits gelöschte / verschobene Datei nochmals zu verarbeiten ...

[Edit] Falls ich das richtig interpretiere, soll eine vorhandene Datei nur durch eine größere Datei überschrieben werden; in diesem Fall etwa so (ungetestet):

'###################################################################################################
'             Dateien umbenennen,nummerieren und in Zielordner verschieben
'###################################################################################################

        oname = fso.GetBaseName(objitem.Value)

        If Right(zielfolder, 1) <> "\" Then zielfolder = zielfolder & "\"
        For Each sTyp In aTypen 'Dateitypen
            ofilecounter = 0
            For Each oFile In fso.GetFolder(moveordner).Files 							'Quelldateien
                If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
                    ofilecounter = ofilecounter + 1
                    oFile.Name = oname & " - cd" & ofilecounter & "." & sTyp 			'jede Datei umbenennen und mit lfd Nummer versehen und ...
                    WScript.Echo ofile.name
                    If fso.FileExists(zielfolder & oFile.Name) Then 'Zieldatei
                        Set oFileZiel = fso.GetFile(zielfolder & oFile.Name)
                        If oFileZiel.Size >= oFile.Size Then 
                            oFile.Delete
                        Else	
                            oFileZiel.Delete
                            oFile.Move zielfolder
                        End If
                    Else
                        oFile.Move zielfolder
                    End If
                End If
            Next
            If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
                If fso.FileExists(zielfolder & oname & "." & sTyp) Then
                    If fso.GetFile(zielfolder & oname & "." & sTyp).Size >= fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Size Then
                        fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Delete
                    Else
                        fso.GetFile(zielfolder & oname & "." & sTyp).Delete
                        fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Name = oname & "." & sTyp 		'... die Laufnummer (" - 1") wieder entfernen
                    End If
                Else
                    fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Name = oname & "." & sTyp 		'... die Laufnummer (" - 1") wieder entfernen
                End If
                WScript.Echo "1 " & sTyp & "-Datei wurde in zielfolder verschoben"
            ElseIf ofilecounter > 1 Then
                WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielfolder verschoben"
            End If
        Next

'###################################################################################################
'
'           Alle verbliebenen Dateien im moveordner löschen
'
'###################################################################################################

        fso.DeleteFile moveordner & "\*.*". True
    End If
Next
End Sub01.
'###################################################################################################
02.
'             Dateien umbenennen,nummerieren und in Zielordner verschieben
03.
'###################################################################################################
04.

05.
        oname = fso.GetBaseName(objitem.Value)
06.

07.
        If Right(zielfolder, 1) <> "\" Then zielfolder = zielfolder & "\"
08.
        For Each sTyp In aTypen 'Dateitypen
09.
            ofilecounter = 0
10.
            For Each oFile In fso.GetFolder(moveordner).Files 							'Quelldateien
11.
                If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
12.
                    ofilecounter = ofilecounter + 1
13.
                    oFile.Name = oname & " - cd" & ofilecounter & "." & sTyp 			'jede Datei umbenennen und mit lfd Nummer versehen und ...
14.
                    WScript.Echo ofile.name
15.
                    If fso.FileExists(zielfolder & oFile.Name) Then 'Zieldatei
16.
                        Set oFileZiel = fso.GetFile(zielfolder & oFile.Name)
17.
                        If oFileZiel.Size >= oFile.Size Then 
18.
                            oFile.Delete
19.
                        Else	
20.
                            oFileZiel.Delete
21.
                            oFile.Move zielfolder
22.
                        End If
23.
                    Else
24.
                        oFile.Move zielfolder
25.
                    End If
26.
                End If
27.
            Next
28.
            If ofilecounter = 1 Then 'Wenn es nur eine Datei war, ...
29.
                If fso.FileExists(zielfolder & oname & "." & sTyp) Then
30.
                    If fso.GetFile(zielfolder & oname & "." & sTyp).Size >= fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Size Then
31.
                        fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Delete
32.
                    Else
33.
                        fso.GetFile(zielfolder & oname & "." & sTyp).Delete
34.
                        fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Name = oname & "." & sTyp 		'... die Laufnummer (" - 1") wieder entfernen
35.
                    End If
36.
                Else
37.
                    fso.GetFile(zielfolder & oname & " - cd1." & sTyp).Name = oname & "." & sTyp 		'... die Laufnummer (" - 1") wieder entfernen
38.
                End If
39.
                WScript.Echo "1 " & sTyp & "-Datei wurde in zielfolder verschoben"
40.
            ElseIf ofilecounter > 1 Then
41.
                WScript.Echo ofilecounter & " " & sTyp & "-Dateien wurden in zielfolder verschoben"
42.
            End If
43.
        Next
44.

45.
'###################################################################################################
46.
'
47.
'           Alle verbliebenen Dateien im moveordner löschen
48.
'
49.
'###################################################################################################
50.

51.
        fso.DeleteFile moveordner & "\*.*". True
52.
    End If
53.
Next
54.
End Sub

[/Edit]

[Edit2] In Zeile 21 "moveordner" auf "zielfolder" geändert [/Edit2]

Grüße
bastla

cbli (Level 1) - Jetzt verbinden

LÖSUNG 14.10.2011 um 16:17 Uhr

Hallo bastla

Habe gerade deinen Code getestet und bei Archiven mit einer Datei funktioniert es.
Bei Archiven mit 2 oder mehr Dateien wird die Nummerierung nicht korrekt ausgeführt.

z.B

Es sind bereits diese Dateien vorhanden

Lohn - 1.xls
Lohn - 2.xls

Ist nun 1 der zu entpackenden Dateien größer als obenstehende sollte diese ohne den Namen zu ändern überschrieben werden.
Als Ergebnis wird die größere Datei kopiert ,aber mit der Nummerierung wird weitergemacht

Es sieht dann so aus

Lohn - 2.xls
Lohn - 3.xls

D.h die Lohn - 1.xls wird als Name nicht mehr verwendet,was aber in meinem Beispiel der Fall sein sollte.

Ergebnis sollte sein:

Lohn - 1.xls
Lohn - 2.xls

Sind 2 Dateien die zu entpacken sind,größer als die bereits existierenden Dateien, bekomme ich folgendes Ergebnis

Lohn - 3.xls
Lohn - 4.xls

Was ist noch zu ändern ?
Vielen Dank

Gruß
Claus

bastla (Level 5) - Jetzt verbinden

LÖSUNG 14.10.2011 um 16:31 Uhr

Hallo cbli!

Ändere mal (mach ich oben auch) in Zeile 21

oFile.Move moveordner

auf

oFile.Move zielfolder

(und BTW: warum einmal "ordner" und dann wieder "folder"?) ...

Grüße
bastla

cbli (Level 1) - Jetzt verbinden

LÖSUNG 14.10.2011 um 18:26 Uhr

Zitat von bastla:

Hallo cbli!

Ändere mal (mach ich oben auch) in Zeile 21

oFile.Move moveordner
> oFile.Move moveordner
> 

auf

oFile.Move zielfolder
> oFile.Move zielfolder
> 

(und BTW: warum einmal "ordner" und dann wieder "folder"?) ...

Habe einen Teil dieses Scripts aus einem uralten Script kopiert ,in dem ich noch diesen mishmasch hatte.
Mache ich öfters so,wenn ich den Code für gewisse Funktionen brauche.
Hatte aber eh vor das zu korrigieren sobald alles 100% tig läuft.

Hallo bastla

Deine letzte Änderung hats gebracht. Habe noch nicht alles vollständig ausgetestet,aber bisher gabs keine Fehler mehr.
Ich danke dir wirklich recht herzlich,wünsche dir ein schönes Wochenende und werde mir dir deinen Code genauestens anschauen.

Gruß
Claus

cbli (Level 1) - Jetzt verbinden

LÖSUNG 24.10.2011 um 23:56 Uhr

Hallo bastla

Hat leider ein bißchen gedauert,aber jetzt habe ich alles getestet und alles funktioniert großartig !
Nochmals herzlichen Dank an dich.
Beitrag ist wieder als gelöst makiert.

Gruß
Claus

Frage Entwicklung VB for Applications

Ähnliche Inhalte

Per Vbscript bestimmte Zeile ungeachtet der Nummerierung prüfen

gelöst Frage von aletriVB for Applications7 Kommentare

Guten Morgen an alle Der folgende Vbscript fügt einer Texdatei eine bestimmte Zeile ein, das klappt soweit Nun sollte ...

Vbscript bestimmte Zeile ungeachtet der Nummerierung löschen

gelöst Frage von aletriVB for Applications4 Kommentare

Guten Tag an alle Mit folgendem Script lässt sich eine bestimmte Zeile nämlich: "SimObjectPaths.6=Addon Scenery\Europe\Italy\Ancona\simobjects" löschen. Die "SimObjectPaths.X=Addon" ist ...

XLSX Dateien per VBScript automatisch drucken

Frage von mttg18VB for Applications3 Kommentare

Hallo zusammen, wir möchten gerne alle Excel Dateien aus einem Netzwerkordner per VB Script ausdrucken lassen: Folgendes Script habe ...

VBScript - Kopiere lokale Datei auf mehrere Netzwerkpfade

gelöst Frage von chasperlisimba1Batch & Shell6 Kommentare

Hallo liebe Gemeinde Ich versuche folgendes per VBScript zu lösen. Eine Datei soll auf 6 verschiedene Server kopiert werden ...

Neue Wissensbeiträge

Windows 10 V1809: Rollout ist gestartet - kommt per Windows Update

Information von kgborn vor 13 StundenWindows 101 Kommentar

Eine kurze Information für die Admins, die Windows 10 im Programm haben. Microsoft hat die letzte Baustelle (die Inkompatibilität ...

Heise Beitrag Passwort-Sammlung mit 773 Millionen Online-Konten im Netz aufgetaucht

Information von Penny.Cilin vor 15 StundenSicherheit5 Kommentare

Auf Heise Online ist folgender Beitrag veröffentlicht worden: Heise Beitrag passwörter geleakt Ich bin mir jetzt nicht ganz sicher, ...

TEAMS - Skype for business

Tipp von Nebellicht vor 15 StundenMicrosoft Office

Hallo, ms ersetzt Skype for business durch TEAMS. Also, nicht wundern wenn mit der OFFICE365 Umgebung kein Skype for ...

Windows 10: Cortana und die Suche gehen bald wieder eigene Wege

Information von Frank vor 19 StundenWindows 102 Kommentare

Microsoft hat einen neuen Insider Build von Windows 10 veröffentlicht (Fast Ring, Version 18317), wo die digitale Assistentin "Cortana" ...

Heiß diskutierte Inhalte

Uhren gehen immer wieder falsch

Frage von killtecWindows Server23 Kommentare

Hallo, ich habe folgende Konstellation: 1. Physischer DC Div. Virtuelle DC's auf Hyper-V Servern Die Hyper-V-Server, der Physische DC ...

Medienkonverter mit 12 oder 24 Ports gesucht

Frage von wmuellerSwitche und Hubs22 Kommentare

Guten Morgen, ich bin auf der Suche nach einem größeren Medienkonverter, der "stumpf" 1:1 die Ports auf über ein ...

OpenSSH Login mit Public Key schlägt fehl, mit Passwort funktioniert

gelöst Frage von DKowalkeDebian19 Kommentare

Hallo zusammen, ich hatte hier schon nach einer Anleitung für einen SFTP Server mit Linux gefragt, habe dort auch ...

VM wächst schnell von 14 auf 35 GB an - warum?

Frage von degudejungWindows 1018 Kommentare

Hallo, ich bin ein Freund schlanker VMs und setze daher gerne mit dem Erscheinen einer neuen Win10 Version - ...

Frage Entwicklung VB for Applications gelöst Hta und Vbscript - Dateien mit Array filtern - automatisch umbenennen und bei bestimmten Dateien eine Nummerierung dem Dateinamen hinzufügen

06.10.2011, aktualisiert 14.10.2011, 4251 Aufrufe, 16 Kommentare

Per Vbscript bestimmte Zeile ungeachtet der Nummerierung prüfen

Vbscript bestimmte Zeile ungeachtet der Nummerierung löschen

XLSX Dateien per VBScript automatisch drucken

VBScript - Kopiere lokale Datei auf mehrere Netzwerkpfade

Windows 10 V1809: Rollout ist gestartet - kommt per Windows Update

Heise Beitrag Passwort-Sammlung mit 773 Millionen Online-Konten im Netz aufgetaucht

Windows 10: Cortana und die Suche gehen bald wieder eigene Wege

Frage Entwicklung VB for Applications
gelöst Hta und Vbscript - Dateien mit Array filtern - automatisch umbenennen und bei bestimmten Dateien eine Nummerierung dem Dateinamen hinzufügen