Office 2010, Word Verknüpfte Vorlage per VBA entfernen

Hallo zusammen,

wir haben in vielen Dokumenten in Word eine Vorlagen-Verknüpung (Datei -> Optionen -> AddIns -> Vorlagen enthalten die nicht mehr relevant sind und entfernt werden müssen.

Diese zeigen auf einen alten Server der nicht mehr existiert und deshalb dauert das öffnen der Dokumente eine kleine Ewigkeit. Diese Verknüpfungen sehen in etwa so aus:

\\192.168.3.1\daten\WBS\Personal\Arbeitsvertraege EUR\die_alte_vorlage.dotx

Nun ist es nicht machbar alle Dokumente per Hand zu öffen und diese Verknüpfung zu entfernen. Bei Microsoft habe ich hierzu folgenden Artikel bzw. Lösung mittels VBA gefunden:

http://support.microsoft.com/?kbid=830561#4

Habe darin also lediglich die Variable OldServer entsprechend angepasst:


Sub Test()
Dim strFilePath As String
Dim strPath As String
Dim intCounter As Integer
Dim strFileName As String
Dim OldServer As String
Dim objDoc As Document
Dim objTemplate As Template
Dim dlgTemplate As Dialog
Dim nServer As Integer

'hardcode the name of the old server.

OldServer = "{192.168.3.1}"
nServer = Len(OldServer)
strFilePath = InputBox("What is the folder location that you want to use?")

If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\"

strFileName = Dir(strFilePath & "*.doc")
Do While strFileName <> ""
Set objDoc = Documents.Open(strFilePath & strFileName)
Set objTemplate = objDoc.AttachedTemplate
Set dlgTemplate = Dialogs(wdDialogToolsTemplates)
strPath = dlgTemplate.Template

If LCase(Left(strPath, nServer)) = LCase(OldServer) Then
objDoc.AttachedTemplate = NormalTemplate
End If

strFileName = Dir()
objDoc.Save
objDoc.Close
Loop

Set objDoc = Nothing
Set objTemplate = Nothing
Set dlgTemplate = Nothing

End Sub

Wenn ich das Skript starte wir der Pfad abgefragt und es werden auch die Dokumente geöffnet und wieder geschlossen aber danach ist die Verknüpfung noch immer enthalten. Was mache ich falsch?

Viele Grüße
pixel24

'Pfad zu den Dokumenten  
Const strPathDocs = "E:\docs"  
'Logfile für eventuell auftretende Fehler  
Const strPathLogfile = "E:\docs\logfile.txt"  
'Alter Servername   
strOldServer = "\\192.168.3.1"   

Set fso = Wscript.CreateObject("Scripting.Filesystemobject")  
Set objWord = WScript.CreateObject("Word.Application")  
'Wenn das ganze unsichtbar ablaufen soll nächste Zeile auf false setzen  
objWord.Visible = True
objWord.DisplayAlerts = 0
'Im Ordner Rekursiv alle Word-Dokumente verarbeiten  
parseFolders fso.GetFolder(strPathDocs), True
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing

Function parseFolders(fldr, boolRecursion)
    
    For Each file In fldr.Files
   		'Verarbeite nur Dateien mit den Endungen *.doc, *.docx, *.docm   
        If LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 4)) = "docx" Or LCase(Right(file.Name, 4)) = "docm" Then  
            On Error Resume Next
            Set objDoc = objWord.Documents.Open(file.Path)
            If Err.Number <> 0 Then
            	Set objLog = fso.OpenTextFile(strPathLogfile,3,True)
            	objLog.WriteLine("Fehler beim öffnen der Datei: -> " & file.Path)  
            	objLog.Close
            Else
		Set dlgTemplate = objWord.Dialogs(87)
		If Instr(1,dlgTemplate.Template, strOldServer,1) then
                        objDoc.RemoveDocumentInformation (9)
			objDoc.Save
			objDoc.Close True
		else
			objDoc.Close False
		End if
            End If
        End If
    Next
    
    If boolRecursion Then
		For Each subFolder in fldr.SubFolders
			parseFolders subFolder, True
		Next
	End If
End Function

10.10.20.4    192.168.1.3