Formatvorlage für alle Dateien in einem Ordner

Question

Guten Tag,

ich habe einige hundert Word Vorlagen, an denen ich die Formatvorlage anpassen soll.

Das funktioniert wunderbar mit:

Sub Format()

 Application.OrganizerCopy Source:= _
        "H:\DEV\Word\Format\HWK_Telefax_mit-Beispielseiten-und-Platzhalterlogo.docx" _
        , Destination:= _
        "H:\DEV\Word\Format\Test1.docx" _
        , Name:="Standard;1_Fließtext", Object:=wdOrganizerObjectStyles

End Sub

Wobei ich nicht nur das eine sondern viele Obkjekt zu ändern habe.

Wenn ich bei Destination den Dateiname anpasse geht alles wie ich es brauche.

Ich bekomme es aber nicht hin, den Ordner "Format zu durchlaufen und die Änderung für alle enthaltenen Dateien durczuführen.

Wäre klasse, wenn mir hier jemand helden könnte.

Vielen Dank im Voraus und einen guten Wochenstart.

Liebe Grüße

Peter Pfeiffer

Answer 1

Hallo Peter,

hier mal ein Ansatz (ungetestet):

Sub Format()
Dim strName
Dim strEndung
Dim strNameneu

Set FS = CreateObject("Scripting.FileSystemObject")
Set Folder = FS.GetFolder("H:\DEV\Word\Format")
For Each File In Folder.Files
  If File.name Like "*.docx" Then
     strName = Left(File.name, InStrRev(File.name, ".") - 1)
     strEndung = Right(File.name, Len(File.name) - InStrRev(File.name, ".") + 1)
     strNameneu = strName & "_neu" & strEndung
      Application.OrganizerCopy Source:=File.name, Destination:=strNameneu, _
        name:="Standard;1_Fließtext", Object:=wdOrganizerObjectStyles
  End If
Next

End Sub

Gruß

M.O.

Answer 2

Guten Morgen und Danke für den Tipp!

Wenn ich es richtig sehe, nimmt Dein Script die Dateinamen, zerlegt diesen und baut daraus einen neuen Dateinamen mit "_neu".

Danach wird von einen Datei in die neue Datei mit "-neu" kopiert.

Das ist nicht genau das was ich brauche.

Ich habe den Ansatz einmal angepasst.

Sub Format()
Dim strName
Dim strEndung
Dim strNameneu

Set FS = CreateObject("Scripting.FileSystemObject")
Set Folder = FS.GetFolder("H:\DEV\Word\Format")
For Each File In Folder.Files
  If File.Name Like "*.docx" Then
     strName = Left(File.Name, InStrRev(File.Name, ".") - 1)
     strEndung = Right(File.Name, Len(File.Name) - InStrRev(File.Name, ".") + 1)
     strNameneu = strName & strEndung
      Application.OrganizerCopy Source:="H:\DEV\Word\Format\Master.docx", Destination:=strNameneu, _
        Name:="Standard;1_Fließtext", Object:=wdOrganizerObjectStyles
  End If
Next
End Sub

Hier versuche ich die Datei Master.docx als Quelle und die erste gefundene Datei als Ziel anzugeben.

Beim Start des Codes kommt aber eine Debugmeldung bei

      Application.OrganizerCopy Source:="H:\DEV\Word\Format\Master.docx", Destination:=strNameneu, _
        Name:="Standard;1_Fließtext", Object:=wdOrganizerObjectStyles

Kann mir hier jemand weiterhelfen?

Vielen Dank und liebe Grüße

Peter

Answer 3

Hallo Peter,

ich muss zugeben, dass WORD nicht so mein VBA-Feld ist (fast ausschließlich Excel), daher hatte ich den Code nicht probiert und einen Fehler drin: es fehlt der Speicherpfad bei Destination.

Wenn du den Namen unverändert nehmen willst, dann probiere es mal so (wieder ungetestet):

Sub Format()

Set FS = CreateObject("Scripting.FileSystemObject")
Set Folder = FS.GetFolder("H:\DEV\Word\Format")
For Each File In Folder.Files
  If File.Name Like "*.docx" Then
     Application.OrganizerCopy Source:="H:\DEV\Word\Format\Master.docx", Destination:="H:\DEV\Word\Format\" & File.Name, _
        Name:="Standard;1_Fließtext", Object:=wdOrganizerObjectStyles
  End If
Next
End Sub

Teste das aber erst einmal in einer Testumgebung.

Gruß

M.O.

Answer 4

Guten Morgen M.O.

war die letzten 2 TAge leider unterwegs, daher erst heute mein Feedback.

Vielen Dank!  Geht wunderbar.

Liebe Grüße und eine schöne Restwoche.

Peter