hanspeter92
Goto Top

Word Makro Kopfzeile mit Namen und Datum

Hallo

Ich habe ein Makro erstellt, dass in einem Ordner allen Word-Dokumenten eine Kopfzeile mit Datumsfeld und Namen hinzufügt.
Do sieht der Code aus:


Sub KopfFussZeile2()
'
' KopfFussZeile2 Makro
'
Const pathDocs = "D:\"
Const wdHeaderFooterEvenPages = 3
Const wdHeaderFooterFirstPage = 2
Const wdHeaderFooterPrimary = 1
Dim counter, strFailureDocs
counter = 0

Set fso = CreateObject("Scripting.FileSystemObject")
Set objWord = CreateObject("Word.Application")
'Wenn der Vorgang nicht sichtbar ausgeführt werden soll folgende Zeile auf 'False' setzen
objWord.Visible = True
objWord.DisplayAlerts = False
For Each file In fso.GetFolder(pathDocs).Files
If LCase(Right(file.Name, 4)) = "docx" Or LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 3)) = "dot" Or LCase(Right(file.Name, 4)) = "dotx" Or LCase(Right(file.Name, 4)) = "dotm" Then

On Error Resume Next
'Öffne Dokument
Set doc = objWord.Documents.Open(file.Path)
If Err.Number = 0 Then
'Zähle bearbeitete Dokumente
counter = counter + 1
For Each Section In doc.Sections


'Setze den Inhalt der folgenden Fußzeilen gleich der Fußzeile der ersten Seite des Abschnitts
Section.Headers(wdHeaderFooterPrimary).Range.InsertDateTime DateTimeFormat:="dd.MM.yyyy", InsertAsField:=True, DateLanguage:=wdSwissGerman, CalendarType:=wdCalendarWestern

Section.Headers(wdHeaderFooterPrimary).Range.Text = vbTab & vbTab & "gewünschter Text "

Next

'Speichere und schließe Dokument
doc.Save
doc.Close True
Else
strFailureDocs = strFailureDocs & file.Path & vbNewLine
Err.Clear
End If
End If
Next
objWord.DisplayAlerts = False
objWord.Quit True
MsgBox counter & " Dokumente bearbeitet!"
If strFailureDocs <> "" Then
MsgBox "Folgende Dokumente wurden wegen eines Fehlers beim Öffnen nicht bearbeitet: " & vbNewLine & strFailureDocs, vbExclamation
End If
End Sub


Nun wird aber das Datum vom Namen überschrieben. Kann man dies irgenwie umgehen?

Besten Dank und Gruss
Hanspeter92

Content-Key: 274223

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

Printed on: April 27, 2024 at 03:04 o'clock

Mitglied: 114757
114757 Jun 10, 2015 at 17:54:20 (UTC)
Goto Top
Dein Fehler liegt hier:
Section.Headers(wdHeaderFooterPrimary).Range.Text = vbTab & vbTab & "gewünschter Text "  
Damit überschreibst du den Header.
Damit nicht mehr:
Section.Headers(wdHeaderFooterPrimary).Range.Text = Section.Headers(wdHeaderFooterPrimary).Range.Text & vbTab & vbTab & "gewünschter Text "  
Gruß jodel32