Sub AlleDateienimVerzeichnisAendern() 
' Allen Dateien eines Verzeichnisses eine andere Dokumentvorlage zuweisen 
 
    'Variablen declaration 
    strServerAlt = "\\SERVERA\" 
    strServerNeu = "\\SERVERB\" 
    strVerzeichnis = "C:\blabla\" 
 
    With Application.FileSearch 
         .NewSearch 
         .FileName = "*.doc" 
         .LookIn = strVerzeichnis 
         .SearchSubFolders = True 
 
        If .Execute() > 0 Then 
            ReDim strDateien(.FoundFiles.Count) 
            ReDim strZugehOrdner(.FoundFiles.Count) 
 
            'Durchläuft alle Dateien, die in dem obigen Verzeichnis vorhanden 
            ' sind. 
            For i = 1 To .FoundFiles.Count 
                strDateien(i) = .FoundFiles(i) 
                strZugehOrdner(i) = .FoundFiles(i) 
 
                Do 
                    strDateien(i) = Right(strDateien(i), (Len(strDateien(i)) - _
                      InStr(strDateien(i), "\"))) 
                Loop While InStr(strDateien(i), "\") > 0 
 
                Documents.Open FileName:=strZugehOrdner(i) 
 
                'Dialog "Tools -> Templates and Addins" öffnen und "Document" & _
                  "Template" auslesen 
                Set dlgTemplate = Dialogs(wdDialogToolsTemplates) 
                strPath = dlgTemplate.Template 
 
 
                If strPath = "Normal" Then 
                    ActiveDocument.Close 
                ElseIf Left(strPath, 3) = "C:\" Then 
                    ActiveDocument.Close 
                ElseIf Left(strPath, 9) = "\\SERVERB" Then 
                    ActiveDocument.Close 
                Else 
                    strPath = Right(strPath, Len(strPath) - Len(strServerAlt)) _
                      'hier wird die angegebene Anzahl der Zeichen 
                    ' abgeschnitten!!!! 
                    strPath = strServerNeu + strPath 
 
 
                    With ActiveDocument 
                         .AttachedTemplate = strPath 
                         .Save 'verhindert, dass Speichernachfrage kommt 
                         .Close 
                    End With 
                End If 
            Next i 
        End If 
    End With 
End Sub