|
10-14-2016, 07:28 AM
|
|
Novice
|
|
Join Date: Feb 2016
Posts: 12
|
|
HI Gmyaor
With help from others and google, I created the following code for updating the footers and the properties in wordfiles, located in a folder. How can I now implement your function?
Quote:
Sub SetDocPropsPlus()
'
' SetDocPropsPlus Makro
Dim dd1 As Document
Dim dokupfad As String, endung As String, dateiname As String
dokupfad = "C:\Users\CGL-TEAM1\Desktop\Test Ordner\" '**der Pfad, in dem die zu bearbeitenden Dokumente liegen anpassen!
endung = "*.docx" '**Anpassen, falls nötig!
dateiname = Dir(dokupfad & endung)
'**********Beginn der Schleife durch alle Dateien im Ordner ***************
Do While dateiname <> ""
Set dd1 = Documents.Open(FileName:=dokupfad & dateiname) 'öffnet das Dokument
'********************* Zu wiederholende "Arbeit"****************************************** *************
If Documents.Count > 0 Then
Dim dp As Object
Set dp = ActiveDocument.BuiltInDocumentProperties
dp("Title") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
dp("Subject") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
dp("Keywords") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
dp("Category") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
dp("Comments") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
dp("Author") = "© CGLN-Team 2017,2018,2019,"
dp("Company") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
dp("Manager") = "© CGLN-Team und IKA GmbH 2017,2018,2019,"
End If
'Fusszeile ganzer Inhalt erneuern
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Fields.Update
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'Dokument speichern
dd1.Save
'Dateien schliessen
dd1.Close
Set dd1 = Nothing
'********************Fortsetzung der Schleife durch alle Dokumente********************
dateiname = Dir ' nächste Datei
Loop
End Sub
|
|