Änderungen an Stapelvorlagen (Microsoft Word)

Sub ChangeTemplates()

Dim strDocPath As String     Dim strTemplateB As String     Dim strCurDoc As String     Dim docCurDoc As Document

' set document folder path and template strings     strDocPath = "C:\path to document folder\"

strTemplateB = "C:\path to template\templateB.dotx"



' get first doc - only time need to provide file spec     strCurDoc = Dir(strDocPath & "*.doc?")



' ready to loop (for as long as file found)

Do While strCurDoc <> ""

' open file         Set docCurDoc = Documents.Open(FileName:=strDocPath & strCurDoc)

' change the template         docCurDoc.AttachedTemplate = strTemplateB         ' save and close         docCurDoc.Close wdSaveChanges         ' get next file name         strCurDoc = Dir     Loop     MsgBox "Finished"

End Sub

Sub TemplateBatchChange()

Dim objPropertyReader     Dim strFolder As String     Dim strFileName As String     Dim objThisDoc As Word.Document     Dim strFindTemplate As String     Dim strReplaceTemplate As String     Dim strAffectedDocs As String

On Error Resume Next

'Create the PropertyReader object     Set objPropertyReader = CreateObject("DSOleFile.PropertyReader")

If Err.Number <> 0 Then         MsgBox "You must install the DSOleFile component. See " & _           "http://support.microsoft.com/?kbid=224351"

GoTo FinishUp     End If

'Get the template names     strFindTemplate = UCase(InputBox("Name of template to find"))

7     strReplaceTemplate = InputBox("Name of replacement template")



'Make sure it's a valid template. Try to create a new document based on it.

Set objThisDoc = Word.Documents.Add(strReplaceTemplate, Visible:=False)

If Err.Number <> 0 Then         'No such template         MsgBox "There is no accessible template named " & strReplaceTemplate         GoTo FinishUp     End If     'Close the test document     objThisDoc.Close wdDoNotSaveChanges

On Error GoTo ErrorHandler     'Get the current documents path     strFolder = Word.Application.Options.DefaultFilePath(wdDocumentsPath) _       & Word.Application.PathSeparator

'Examine all Word documents in the directory

'Get the first document name     strFileName = Dir(strFolder & "*.doc?")



While strFileName <> ""

'Look at the template name         If UCase(objPropertyReader.GetDocumentProperties _           (strFolder & strFileName).Template) = strFindTemplate Then

'It matches. Open the document             Set objThisDoc = Word.Documents.Open _               (FileName:=strFileName, Visible:=False)



'Change the attached template             objThisDoc.AttachedTemplate = strReplaceTemplate

'Save the change             objThisDoc.Close wdSaveChanges

'Note the document             strAffectedDocs = strAffectedDocs & strFileName & ", "

End If         'Get the next document         strFileName = Dir     Wend

'Report the results     If strAffectedDocs = "" Then         MsgBox "No documents were changed.", , "Template Batch Change"

Else         'Remove the trailing comma and space         strAffectedDocs = Left(strAffectedDocs, Len(strAffectedDocs) - 2)



MsgBox "These documents were changed: " & _           strAffectedDocs, , "Template Batch Change"

End If     GoTo FinishUp

ErrorHandler:

Set objThisDoc = Nothing     Set objPropertyReader = Nothing     Err.Raise vbError + 1001, "TemplateBatchChange", _       "TemplateBatchChange encountered an error: " & Err.Description

FinishUp:

'Release object references     Set objThisDoc = Nothing     Set objPropertyReader = Nothing End Sub