joni2000de
Goto Top

Dateien umbenennen und verschieben mit VBS

Hallo Admins,

ich habe beim folgenden Script noch ein paar Problemchen, bei denen ich auf Hilfe hoffe.

'P F A D E   A N F A N G =============================================================================================================  

quelle = "E:\Scanordner\"			'Pfad inkl. \  
ziel = "E:\Objekte\"  
zielpfad = "\11_laufende_Buchhaltung\Rechnungen\Eingangsrechnungen\"	'Pfadteil nach der Objektnummer - Beginn und Ende mit \									'Pfad inkl. \  

'P F A D E   E N D E =============================================================================================================  

'U S E R N A M E   A U S L E S E N  
Set objNetwork = CreateObject("WScript.Network")  
username = objNetwork.UserName
'msgbox(Username)  

'D A T U M    U N D   Z E I T    F E S T L E G E N    U N D   F O R M A T I E R E N  
DD = Date
dt = Year(DD) & "-" & Right("0" & Month(DD), 2) & "-" & Right("0" & Day(DD), 2)  

ZZ = Time
zt = Left(ZZ, 2) & "-" & Mid(ZZ, 4, 2) & "-" & Right(ZZ, 2)  

'L O G D A T E I   F E S T L E G E N  
logdat = "e:\Scanordner\" & username & "\log_" & dt & "_" & zt & ".txt"  
'msgbox(logdat)  

'Q U E L L P F A D   D E S   U S E R S   F E S T L E G E N  
quellpfad = quelle & username & "\"  
'msgbox(quellpfad)  

'D A T E I E N   A B F R A G E N  
on error resume next
set fs = CreateObject("Scripting.FileSystemObject")  
set f = fs.GetFolder(quellpfad)
Set y = fs.CreateTextFile(logdat, True)

For Each file in f.Files

if right(file.Name, 4) = ".pdf" then							'nur PDFs bearbeiten  

	alt = file.Name									'alten Namen speichern  
	'msgbox(alt)  
'Eingabe:  
	onr = InputBox("Objektnummer bitte angeben:", "Objektnummer", onr)  
	rdat = InputBox("Rechnungsdatum bitte angeben (TTMMJJ):", "Rechnungsdatum", rdat)  
	korr = InputBox("Eingaben korrekt?" & vbCrLf & "Objektnummer: " & onr & vbCrLf & "Datum: " & left(rdat, 2) &_  
	"." & mid(rdat,3,2) & ".20" &right(rdat,2), "Eingabekontrolle", "ja")  
'	if korr <> "ja" or korr <> "j" then goto Eingabe  
	file.Name = onr & " Rechnung vom 20" & right(rdat,2) & mid(rdat,3,2) & left(rdat, 2) & ".pdf"  
	neu = file.Name
	'msgbox(neu)  

	if fs.FileExists(neu) then msgbox("gibt es schon")									'neunen Namen speichern  

	if fs.FolderExists(ziel & ONR & zielpfad) then
		if quellpfad <> ziel & ONR & zielpfad then								'Zielverzeichnis darf nicht gleich Quelle sein  
			file.move (ziel & ONR & zielpfad)						'ins Zielverzeichnis verschieben  
			y.WriteLine(quellpfad & alt & " >>> " & ziel & ONR & zielpfad & neu & " <<< +v+u")		'Wenn der Ordner existiert wurde die Datei verschoben + protokolliert  
		else
			fs.CreateFolder(quellpfad & "fertig\")						'Ordner erzeugen, da Ziel gleich Quelle  
			file.move (quellpfad & "fertig\")							'in neuen Ordner verschieben  
			y.WriteLine(quellpfad & alt & " >>> " & quellpfad & "fertig\" & neu & " <<< -v+u Quelle gleich Ziel")	'Wenn Ziel gleich Quelle wird nur die Namensänderung protokolliert  

		end if
	else
		fs.CreateFolder(quellpfad & "fertig\")						'Ordner erzeugen, da Ziel nicht vorhanden ist  
		file.move (quellpfad & "fertig\")							'in neuen Ordner verschieben  
		y.WriteLine(quellpfad & alt & " >>> " & quellpfad & "fertig\" & neu & " <<< -v+u kein Ziel vorhanden")	'Wenn der Ordner nicht existiert wird nur die Namensänderung protokolliert  
	end if

End if

Next

y.Close											'Logdatei schließen  

Was klappt noch nicht:
1. Ich würde gerne jeder verschobenen und umbenannten Datei hinten einen Zähler anfügen, der einfach hochzählt.
2. Die Schleife mit der Abfrage ob die Angaben korrekt sind.
3. Das Logfile soll am Schluss automatisch aufgerufen werden.

zu 1.
Im Zielordner sind bereits Dateien vorhanden. Wenn neue dazukommen können diese den gleichen Namen kriegen wie bestehende (abgesehen vom Zähler). D. h. ein fortlaufender Zähler hilft nicht, da bei jeder einzelnen Datei geprüft werden muss ob es diese schon gibt und dann die nächst höhere Zählernummer zu verwenden ist.

zu 2.
Die Schleife mit Eingabe: und Goto will nicht funktionieren (ist nur derzeit ausgeblendet). Wo liegt hier der Denk-/Syntaxfehler?

zu 3.
Wie bringe ich die Datei am Ende auf den Bildschirm?

Danke im Voraus für euer hilfe und Geistesblitze.

Gruß Joni

Content-ID: 147471

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

Ausgedruckt am: 05.11.2024 um 16:11 Uhr

76109
76109 22.07.2010 um 21:42:07 Uhr
Goto Top
Hallo joni2000de!

Mit Ausnahme von "On Error Goto 0", gibt es In VBS keine Goto-Funktion. Alternativ kannst Du aber eine While-Schleife verwenden:

    Do
        .....
        korr = InputBox(....)
    Loop While LCase(Left(korr, 1)) <> "j"  


Gruß Dieter
77559
77559 22.07.2010 um 22:12:05 Uhr
Goto Top
Hallo Dieter,

hab zu lange ferngesehn, aber meine fast fertig gewesene Antwort will ich nicht vorenthalten face-wink

@joni
Formatierungen sind ja großteils eine Frage des persönlichen Geschmacks,
aber teilweise 10 Tabs in Folge sowie die im Internet Bereich übliche Interpretation von fortlaufender Großschrift als SCHREIEN (verstärkt mit gesperrter Schrift als L A U T S C H R E I E N) machen deinen Code - ähem - schlecht lesbar.
Ich, mag mich jedenfalls so, nicht damit beschäftigen.

Gruß
LotPings

@Biber, wir laufen wohl heute zur Hochform auf face-wink Aber man nennt doch die Dinger Ohrenschützer - meinen bitte in Pink.
Biber
Biber 22.07.2010 um 22:16:23 Uhr
Goto Top
[OT]

Zitat von @77559:
Formatierungen sind ja großteils eine Frage des persönlichen Geschmacks,
aber teilweise 10 Tabs in Folge sowie die im Internet Bereich übliche Interpretation von fortlaufender Großschrift als SCHREIEN
(verstärkt mit gesperrter Schrift als L A U T S C H R E I E N) machen deinen Code - ähem - schlecht lesbar.
Ich, mag mich jedenfalls so, nicht damit beschäftigen.
Hmmm, ich spiele eh mit dem Gedanken, vielleicht einen Kopfhörer-Verleih aufzumachen...
...evtl in Kombination mit stark getönten Sonnenbrillen...

Würde das helfen?

Grüße
Biber
[/OT]
76109
76109 22.07.2010 um 23:12:48 Uhr
Goto Top
[OT]

Hallo LotPings und Biber!

Also, am Beitrag selbst kann ich kein ungebührliches Verhalten erkennen und wenn's im Code mit der Schreibung etwas übertrieben erscheint, ähem keine Ahnung, ob ich das jetzt negativ bewerten soll. Ist mir auch ehrlich gesagt erst im Nachhinein aufgefallen und Ohrenstöpsel (grün), habe ich ne Schüssel voll face-smile

Gruß Dieter

[/OT]
bastla
bastla 22.07.2010 um 23:55:37 Uhr
Goto Top
Hallo joni2000de!

Den Vorbehalten hinsichtlich der Formatierung schließe ich mich an (wie sieht denn das aus, wenn's derart in die Breite geht face-wink - obwohl ich einräume, dass auch die Tatsache, dass ein TAB durch die Forensoftware in der Breite von 8 Leerzeichen dargestellt wird, ihren Teil zu diesem Erscheinungsbild beiträgt) ...
Für 3. sollte
CreateObject("WScript.Shell").Run logdat
genügen.

Grüße
bastla

P.S.: Ohrenstöpsel brauche ich nicht - habe defaultmäßig auf Durchzug gestellt ... face-wink
joni2000de
joni2000de 23.07.2010 um 09:13:31 Uhr
Goto Top
Guten Morgen die Herren!

vorerst danke an alle!
=> Dieter und bastla für die Hilfe bei meinem Problem
=> der Rest für die kreativen Ausführungen zum Thema
"Mein Lieber Lord Boyet, obwohl meine Schönheit nur durchschnittlich ist benötigt Sie nicht die Ausschmückung eures Lobgesangs, denn Schönheit liegt im Auge des Betrachters und muss nicht durch die Zunge des Hausierers angepriesen werden." - Love's Labours Lost, 1588 / Die Prinzessin von Frankreich

(Original engl. "Good Lord Boyet, my beauty, though but mean, Needs not the painted flourish of your praise: Beauty is bought by iudgement of the eye, Not uttred by base sale of chapmens tongues")

edit/ Hab noch vergessen den Schöpfer des obigen Zitates anzuführen: William Shakespeare

2. und 3. sind somit gelöst.
Hat jemand noch für 1. eine Idee.

Gruß Joni
joni2000de
joni2000de 23.07.2010 um 09:50:26 Uhr
Goto Top
Hallo bastla,

da ist noch eine Frage aufgetaucht.

Wie kann ich die Logdatei die ich mit

CreateObject("WScript.Shell").Run logdat  

erzeugt habe wieder schließen. Zum Zeitpunkt an dem die Datei geschlossen werden soll ist sie nicht aktiv => SendKeys funktioniert somit nicht.

Danke

Gruß Joni
77559
77559 23.07.2010 um 12:16:34 Uhr
Goto Top
Hallo Joni,

wie willst du die Versionsnummer denn anhängen, einfach ohne Trenner, mit fester Stellenzahl, in Klammern etc.?

Gruß
LotPings

@Biber, immerhin sind wir noch im Kontext der ersten Frage - und meine Gegenfragen sollten zum Denken anregen.
Wessen essen.. ich hab gerade erst kalt gefrühstückt; obwohl der Kaffe war schon heiss face-wink
Biber
Biber 23.07.2010 um 12:19:01 Uhr
Goto Top
[OT]
Zitat von @77559:
wie willst du die Versionsnummer denn anhängen, einfach ohne Trenner, mit fester Stellenzahl, in Klammern etc.?
Und wenn er auf diese Suggestivfrage mit "Gerne!" antwortet, dann ufert das wieder aus..
[/OT]

@77559, "zum Denken anregen" finde ich gut.... aber nicht, dass dann wieder das Essen kalt wird...
joni2000de
joni2000de 23.07.2010 um 12:43:18 Uhr
Goto Top
Hi,

ich hätte da an die Variante Text_01.pdf, Text_02.pdf,... gedacht.

2 Stellen reichen, da pro Objekt und pro Tage sicher nicht mehr als 99 Rechnungen einlagen werden.

Bevor die Nummerierung festgelegt wird muss geprüft werden ob bereits eine Datei mit dem gleichen Namen (ohne lfd. Nummer) vorhanden ist.
z. B. vergleiche den Namen ohne die letzten 7 Stellen

Wenn dann ein Treffer gefunden wird, muss die lfd. Nr. des Treffers ermittelt werden.
Dann muss geprüft werden ob es noch einen Treffer gibt und wenn ja welche lfd. Nr. der hat. Die höhere der beiden ist zu übernehmen.
Das solange bis keine Treffer mehr vorhanden sind.
Die neue Datei erhält dann die lfd. Nr. +1

Die Dateizusammenstellung kann zB so aussehen:

Rechnung vom 20100819_01.pdf
Rechnung vom 20100819_02.pdf
Rechnung vom 20100820_01.pdf
Rechnung vom 20100821_01.pdf
Rechnung vom 20100821_02.pdf
Rechnung vom 20100821_03.pdf

Und dann kommt eine neue "Rechnung vom 20100820" die dann die Nummer _02 erhalten müsste.

Bitte Gerne face-wink

Gruß Joni
77559
77559 23.07.2010, aktualisiert am 18.10.2012 um 18:42:56 Uhr
Goto Top
Das passt ja ziemlich genau auf eine rekursive Funktion die ich hier in Batch realisiert habe, hatte ich auch schon einmal in vbs geschrieben - finde ich aber gerade nicht (muss wirklich mal einen Hausputz machen face-wink )

Aber vielleicht schaust du dir den Code mal an und versuchst es selber als vbscript zu schreiben.

Gruß
LotPings
joni2000de
joni2000de 23.07.2010 um 14:25:18 Uhr
Goto Top
Hi LotPings,

ich kann deinem Code so ungefähr folgen, doch das in vbs übersetzten, daraus wird wohl nix face-sad
Dazu bin ich zu dünn unterwegs. Falls dein Hausputz erfolgreich ist, würde mir das weiterhelfen.

Entgegen dem Beispiel muss bei mir die Nummerierung aber nicht "nach hinten verschoben" werden, sondern es reicht wenn einfach die nächste Nummer verwendet wird.

Gruß Joni
76109
76109 23.07.2010 um 15:10:43 Uhr
Goto Top
Hallo joni2000de!

Hier mal ein Beispiel zum Verschieben einer Datei mit Zähler, wobei es wenig Sinn macht, die Datei erst umzubenennen und dann erst zu prüfen, ob die Datei bereits existiert... D.h. nach der neuen Namensbildung anhand einer Zählerschleife ermitteln, ob die Datei im Zielpfad schon existiert. Wenn nicht, dann wird der neue Dateinamen gebildet und unter dem neuen Dateinamen verschoben.

Const Quellpfad = "E:\Quelle\"  

Const Zielpfad = "E:\Ziel\"  

Dim Fso, File, ZielName, FilePfad, i
    
Set   Fso = CreateObject("Scripting.FileSystemObject")  
    
For Each File In Fso.GetFolder(Quellpfad).Files
    
    If LCase(Fso.GetExtensionName(File.Name)) = "pdf" Then  
        
       'ZielNamen durch Eingabe bilden .... z.B.  
        ZielName = "123456 Rechnung vom 20100723"  
            
        i = 1  'Zähler = 1  
            
        Do Until Fso.FileExists(Zielpfad & ZielName & "_" & Right("0" & i, 2) & ".pdf") = False: i = i + 1:  Loop  
        
       'Zielpfad mit neuem Dateinamen  
        FilePfad = Zielpfad & ZielName & "_" & Right("0" & i, 2) & ".pdf"  
            
        File.Move FilePfad
    End If
Next

Gruß Dieter
joni2000de
joni2000de 23.07.2010 um 16:00:18 Uhr
Goto Top
Hallo Dieter,

dein Vorschlag hat funktioniert. Danke!

Somit wäre 1. - 3. erledigt und nur noch die Zusatzfrage offen, wie ich ein geöffnetes, im hintergrundbefindliches Fenster (habe ich vorher mit dem Script CreateObject("WScript.Shell").Run logdat geöffnet), wieder schließen kann.

Wenn ich da auch noch einen Tipp kriegen könnte, wäre mein Wochenende gerettet.

Gruß Joni
joni2000de
joni2000de 23.07.2010 um 17:30:42 Uhr
Goto Top
Hallo zusammen,

hier mein Ergebnis, für alle die es trotz der Formatierungsschwächen interessiert face-wink

Zusätzlich wird jetzt immer die zu benennende Datei mit geöffent und wieder geschlossen.

'P F A D E   A N F A N G =============================================================================================================  

quelle = "E:\Scanordner\"			'Pfad inkl. \  
ziel = "E:\Objekte\"				'Pfad inkl. \  
zielpfad = "\11_laufende_Buchhaltung\Rechnungen\Eingangsrechnungen\"	'Pfadteil nach der Objektnummer - Beginn und Ende mit \  

'P F A D E   E N D E =============================================================================================================  

'U S E R N A M E   A U S L E S E N  
Set objNetwork = CreateObject("WScript.Network")  
username = objNetwork.UserName
'msgbox(Username)  

'D A T U M    U N D   Z E I T    F E S T L E G E N    U N D   F O R M A T I E R E N  
DD = Date
dt = Year(DD) & "-" & Right("0" & Month(DD), 2) & "-" & Right("0" & Day(DD), 2)  

ZZ = Time
zt = Left(ZZ, 2) & "-" & Mid(ZZ, 4, 2) & "-" & Right(ZZ, 2)  

'L O G D A T E I   F E S T L E G E N  
logdat = "e:\Scanordner\" & username & "\log_" & dt & "_" & zt & ".txt"  
'msgbox(logdat)  

'Q U E L L P F A D   D E S   U S E R S   F E S T L E G E N  
quellpfad = quelle & username & "\"  
'msgbox(quellpfad)  

'D A T E I E N   A B F R A G E N  
on error resume next
set fs = CreateObject("Scripting.FileSystemObject")  
set f = fs.GetFolder(quellpfad)
Set y = fs.CreateTextFile(logdat, True)

For Each file in f.Files

if right(file.Name, 4) = ".pdf" then							'nur PDFs bearbeiten  

	alt = file.Name									'alten Namen speichern  
	'msgbox(alt)  
	CreateObject("WScript.Shell").Run quellpfad & alt				'PDF zur Info öffnen  
	Set shell = WScript.CreateObject("WScript.Shell")   

	Do
		WScript.Sleep 1000
		onr = InputBox("Objektnummer bitte angeben:", "Objektnummer", onr)  
		rdat = InputBox("Rechnungsdatum bitte angeben (TTMMJJ):", "Rechnungsdatum", rdat)  
		korr = InputBox("Eingaben korrekt?" & vbCrLf & "Objektnummer: " & onr & vbCrLf & "Datum: " & left(rdat, 2) &_  
		"." & mid(rdat,3,2) & ".20" &right(rdat,2), "Eingabekontrolle", "ja")  
	Loop While LCase(Left(korr, 1)) <> "j"  

	i = 1										'Zähler auf 1 stellen  
	Do Until fs.FileExists(ziel & onr & zielpfad & onr & "_Rechnung_vom_20" & right(rdat,2) & mid(rdat,3,2) & left(rdat, 2) & "_" & Right("0" & i, 2) & ".pdf") = False: i = i + 1:  Loop 'nächste freie Nummer suchen  

	shell.appactivate(quellpfad & alt)
	shell.sendkeys ("%{F4}"), true 							'wie ALT+F4  
	WScript.Sleep 100 								'Wichtig!!!	  

	file.Name = onr & "_Rechnung_vom_20" & right(rdat,2) & mid(rdat,3,2) & left(rdat, 2) & "_" & Right("0" & i, 2) & ".pdf"  
	neu = file.Name
	'msgbox(neu)  

	if fs.FolderExists(ziel & ONR & zielpfad) then
		if quellpfad <> ziel & ONR & zielpfad then								'Zielverzeichnis darf nicht gleich Quelle sein  
			file.move (ziel & ONR & zielpfad)						'ins Zielverzeichnis verschieben  
			y.WriteLine(quellpfad & alt & " >>> " & ziel & onr & zielpfad & neu & " <<< +v+u")		'Wenn der Ordner existiert wurde die Datei verschoben + protokolliert  
		else
			fs.CreateFolder(quellpfad & "fertig\")						'Ordner erzeugen, da Ziel gleich Quelle  
			file.move (quellpfad & "fertig\")							'in neuen Ordner verschieben  
			y.WriteLine(quellpfad & alt & " >>> " & quellpfad & "fertig\" & neu & " <<< -v+u Quelle gleich Ziel")	'Wenn Ziel gleich Quelle wird nur die Namensänderung protokolliert  

		end if
	else
		fs.CreateFolder(quellpfad & "fertig\")						'Ordner erzeugen, da Ziel nicht vorhanden ist  
		file.move (quellpfad & "fertig\")							'in neuen Ordner verschieben  
		y.WriteLine(quellpfad & alt & " >>> " & quellpfad & "fertig\" & neu & " <<< -v+u kein Ziel vorhanden")	'Wenn der Ordner nicht existiert wird nur die Namensänderung protokolliert  
	end if

End if

Next

y.Close											'Logdatei schließen  

CreateObject("WScript.Shell").Run logdat						'Logdatei anzeigen  
joni2000de
joni2000de 23.07.2010 um 18:36:04 Uhr
Goto Top
Da bin ich nochmal.

Es ist doch noch eine Frage aufgetaucht. Das Öffnen der PDFs und das Umbenennen/Verschieben kommt sich teilweise in die Quere. Bei den Tests hat es funktioniert aber im Echtbetrieb ist es eher wie bei der Lotterie.

Wenn ich die PDFs nicht anzeigen lasse klappt alles wunderbar. Gibt es eine Möglichkeit die beiden Prozesse "auseinander zu halten"?

Danke

Gruß Joni
76109
76109 23.07.2010 um 21:34:21 Uhr
Goto Top
Hallo joni2000de!

Geöffnete Dateien können logischerweise nicht umbenannt/verschoben werden. Und da Du die Fehlerbehandlung mit "On Error Resume Next" außerkraft gesetzt hast, bekommst Du natürlich auch keine entsprechenden Fehlermeldung. Letztendlich bleibt es so oder so ein Lotteriespielface-wink

Du kannst mal versuchen, die Datei zu öffnen und manuell wieder zu schließen. Das geht in Zeile 41 mit folgender Codezeile:
CreateObject("WScript.Shell").Run quellpfad & alt, 1, True  
wobei das True am Ende bedeutet, dass die Script-Ausführung bis zum Schließen der Datei angehalten wird.

Gruß Dieter
joni2000de
joni2000de 26.07.2010 um 15:59:18 Uhr
Goto Top
Hallo Dieter,

die Datei ist zum Zeitpunkt des Umbenennens oder Verschiebens nicht offen (sollte zumindest nicht). Da wird es sich vermutlich um ein timingproblem handeln. Doch dein Tipp hat dann die Lösung gebracht. Ich mache eine Kopie der Datei die ich umbenennen und verschieben möchte. Diese Kopie verwende ich für die Anzeige. Beim 2. Durchlauf mache ich eine 2. Kopie. Beim 3. wird dann die erste Kopie überschrieben, beim 4. die 2. usw. somit kann ich das Problem umgehen und es funktioniert. Am Ende die 2 Kopien in den Kübel schmeißen und fertig.

Nochmal danke für deine Hilfe!

Gruß Joni