Sep 03, 2013, updated at 13:40:30 (UTC)

2789

Auto-Datumsfeld in Word durch Erstellungsdatum ersetzen

Hallo zusammen,
folgendes Problem: In mehreren Word-Dateien sind in der Fußzeile Auto-Datums-Felder (bzw. eins pro Datei) hinzugefügt worden. Diese dürften eigentlich nicht da sein und müssen durch das Erstellungsdatum ersetzt werden.
Gibt es hier eine Möglichkeit dies ohne extremen Aufwand zu erledigen?
Es sind sowhl Word 97 als auch 2007 Dateien (also .doc und .docx)
Problem: Diese Dateien sind in mehreren Unterverzeichnissen. Das Ändern müsste also von einer Root-Ebene Rekursiv laufen.

EDIT: Ich muss im Prinzip den Teil: { TIME \@ "dd.MM.yyyy" } durch diesen ersetzen: { CREATEDATE \@ "dd.MM.yyyy" }

Gruß

Please also mark the comments that contributed to the solution of the article

Content-Key: 215940

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

Printed on: April 24, 2024 at 07:04 o'clock

15 Comments

Latest comment

Hallo killtec,
könnte man mit folgendem VBS-Script so lösen:
In Zeile 1 noch den Root-Pfad zu dem Dokumenten angeben.

Const strPathDocs = "E:\Scripte\docs"  

Set fso = Wscript.CreateObject("Scripting.Filesystemobject")  
Set objWord = WScript.CreateObject("Word.Application")  
'Wenns unsichtbar passieren soll hier auf false setzen  
objWord.Visible = True
objWord.DisplayAlerts = 0
parseFolders fso.GetFolder(strPathDocs), True
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing

Function parseFolders(fldr, boolRecursion)
    
    For Each file In fldr.Files
        If LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 4)) = "docx" Then  
            set objDoc = objWord.Documents.Open(file.Path)
            
            For Each section In objDoc.Sections
	            For Each f In section.Footers(1).Range.Fields
	                If UCase(Left(Trim(f.Code), 4)) = "TIME" Then  
	                    f.Select
	                    objDoc.Fields.Add objWord.Selection.Range, 21, "\@ ""dd.MM.yyyy""",True  
	                End If
	            Next
            Next
            objDoc.Close True
        End If
    Next
    
    If boolRecursion Then
		For Each subFolder in fldr.SubFolders
			parseFolders subFolder, True
		Next
	End If
End Function

probiers mal aus...

Grüße Uwe

Hallo Uwe,
das Script öffnet zumindest die Files. Diese werden jedoch direkt wieder geschlossen. Eine Änderunge sehe ich leider nicht im Footer. Beim Überprüfen der Dateien ist mir aufgefallen, dass es auch über den Befehl "DATE" eingefügt sein kann. Demnach müsste ich ja die Zeile 22 vor dem Then mit diesem erweitern oder?:

or UCase(Left(Trim(f.Code), 4)) = "DATE" Then

so dass man dann

If UCase(Left(Trim(f.Code), 4)) = "TIME" or UCase(Left(Trim(f.Code), 4)) = "DATE" Then  

hat, sehe ich das richtig?
Wie sieht es mit dem Speichern aus? Muss hier vor dem objDoc.Close True noch ein Save?

Gruß

Zitat von @killtec:

Hallo Uwe,
das Script öffnet zumindest die Files. Diese werden jedoch direkt wieder geschlossen. Eine Änderunge sehe ich leider

Die Überprüfung geht halt so schnell das du es halt nicht siehst, jedes doc wird nach der Bearbeitung ja wieder geschlossen. Haben die Dokumente zufällig Fußzeilen speziell für die erste Seite ? Dann muss man noch eine zusätzliche Prüfung dieser "Footers" vornehmen.

Beim Überprüfen der Dateien ist mir aufgefallen, dass es auch über den Befehl "DATE"
eingefügt sein kann. Demnach müsste ich ja die Zeile 22 vor dem Then mit diesem erweitern oder?:

hat, sehe ich das richtig?

Ja klar kannst du machen, hatte es nur so geschrieben weil du explizit geschrieben hattest das die Dokumente "Time" verwenden.

Wie sieht es mit dem Speichern aus? Muss hier vor dem objDoc.Close True noch ein Save?

Normalerweise nicht denn das True bedeutet das das Dokument beim schließen gespeichert wird.

Hi Uwe,
danke. Ja, habe mir die Dokumente noch mal angeschaut, mal ist es DATE mal TIME.
Funktionieren tut es so leidern icht. Die Dokumente bestehen immer nur aus einer Seite.

Gruß

Bei mir geht es einwandfrei. Ist in den Fußzeilen zufällig angegeben das diese nur auf der ersten Seite erscheinen sollen ? dann müsste man es noch was ändern ...

wenn die Fußzeile explizit für die erste Seite definiert ist muss die Zeile 21 so geändert werden:

For Each f In section.Footers(2).Range.Fields

Hi,
also in der Fußzeile ist das Feld "Erste Seite anders" aktiviert. Vermutlich liegt es daran.

also in der Fußzeile ist das Feld "Erste Seite anders" aktiviert. Vermutlich liegt es daran

wenn die Fußzeile explizit für die erste Seite definiert ist muss die Zeile 21 so geändert werden:

For Each f In section.Footers(2).Range.Fields

Es gibt hier 3 Konstanten für Footers(x):

wdHeaderFooterPrimary = 1
wdHeaderFooterFirstPage = 2
wdHeaderFooterEvenPages = 3

Kannst diese Fälle ja mit einer zusätzlichen Schleife überprüfen.
so kämen wir dann zu folgendem Script:

Const strPathDocs = "E:\Scripte\docs"  

Set fso = Wscript.CreateObject("Scripting.Filesystemobject")  
Set objWord = WScript.CreateObject("Word.Application")  
objWord.Visible = True
objWord.DisplayAlerts = 0
parseFolders fso.GetFolder(strPathDocs), True
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing

Function parseFolders(fldr, boolRecursion)
    
    For Each file In fldr.Files
        If LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 4)) = "docx" Then  
            set objDoc = objWord.Documents.Open(file.Path)
            
            For Each section In objDoc.Sections
            	For i = 1 To 3
	            	For Each f In section.Footers(i).Range.Fields
		                If UCase(Left(Trim(f.Code), 4)) = "TIME" Or UCase(Left(Trim(f.Code), 4)) = "DATE" Then  
		                    f.Select
		                    objDoc.Fields.Add objWord.Selection.Range, 21, "\@ ""dd.MM.yyyy""",True  
		                End If
		            Next
            	Next
	            
            Next
            objDoc.Close True
        End If
    Next
    
    If boolRecursion Then
		For Each subFolder in fldr.SubFolders
			parseFolders subFolder, True
		Next
	End If
End Function

Grüße Uwe

Hi Uwe,
Danke. Das Script funktioniert nun auch bei mir

Werde das gelich auf alle Dateien ansetzen und dann berichten.

Vielen lieben Dank!!!

Gruß

So, Script bleibt stehen

Leider. Problem: .doc Dokumente eines älterne Formates... Er öffnet diese nicht wegen der Geschützten Ansicht. Lässt sich diese evtl. mit dem Script noch abfangen, dass die zur Bearbeitung aktiviert wird?
Im Normalfall ist die Geschützte Ansicht schon deaktiviert

EDIT: Über ein anderen PC geht es.

Gruß

Korregiere...
Wenn dieser Fehler kommt:

kann man dann die Datei (Namen) nicht in eine CSV oder TXT ausgeben und das Script einfach weiter laufen lassen?

Gruß

Sorry wenn's etwas später geworden ist ...
hier eine Version mit weiterer Fehlerbehandlung und Logfile (Pfad dazu in Zeile 2 eintragen):

Const strPathDocs = "E:\Tempfolder\Scripte\docs"  
Const strPathLogfile = "E:\Tempfolder\Scripte\docs\logfile.txt"  

Set fso = Wscript.CreateObject("Scripting.Filesystemobject")  
Set objWord = WScript.CreateObject("Word.Application")  
objWord.Visible = True
objWord.DisplayAlerts = 0
parseFolders fso.GetFolder(strPathDocs), True
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing

Function parseFolders(fldr, boolRecursion)
    
    For Each file In fldr.Files
        If LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 4)) = "docx" Then  
            On Error Resume Next
            Set objDoc = objWord.Documents.Open(file.Path)
            If Err.Number <> 0 Then
            	Set objLog = fso.OpenTextFile(strPathLogfile,3,True)
            	objLog.WriteLine("Fehler beim öffnen der Datei: -> " & file.Path)  
            	objLog.Close
            Else
            	For Each section In objDoc.Sections
	            	For i = 1 To 3
		            	For Each f In section.Footers(i).Range.Fields
			                If UCase(Left(Trim(f.Code), 4)) = "TIME" Or UCase(Left(Trim(f.Code), 4)) = "DATE" Then  
			                    f.Select
			                    objDoc.Fields.Add objWord.Selection.Range, 21, "\@ ""dd.MM.yyyy""",True  
			                End If
			            Next
	            	Next
	            Next
	            objDoc.Close True
            End If
        End If
    Next
    
    If boolRecursion Then
		For Each subFolder in fldr.SubFolders
			parseFolders subFolder, True
		Next
	End If
End Function