During a fileserver migration I encountered a problem – users started to report that it takes unusually long to open Microsoft Word Documents. I did some investigations on this and found out that Word is saving the FQDN of the template path (*.dot) file. You can see this if you open a document in the Word splash screen.
You can manually change the template path within the document options in word – but what if you have thousands of files and you even don’t know which one are affected?
Here’s the answer: I just wrote a little script that will modify all documents within the given path.
You just need to modify the lines 45, 46, 47 to fit your environment
' ##################################################################### ' ## ' ## (C) 2012 Michael Miklis (michaelmiklis.de) ' ## ' ## ' ## Filename: ChangeWordDocumentTemplate.vbs ' ## ' ## Version: 1.0 ' ## ' ## Release: Final ' ## ' ## Requirements: -none- ' ## ' ## Description: Changes the template in doc files ' ## ' ## This script is provided 'AS-IS'. The author does not provide ' ## any guarantee or warranty, stated or implied. Use at your own ' ## risk. You are free to reproduce, copy & modify the code, but ' ## please give the author credit. ' ## ' #################################################################### Option Explicit Dim strFilePath Dim strPath Dim intCounter Dim strFileName Dim OldServer Dim NewServer Dim objDoc Dim objTemplate Dim dlgTemplate Dim objWord Dim strFileArr Dim objFs Dim i Const wdDialogToolsTemplates = 87 Set objFS = CreateObject("Scripting.Filesystemobject") Set objWord = CreateObject("Word.Application") objWord.Visible = false strFilePath = "C:\Testfiles" OldServer = "\\server_old\share\folder1\folder1.1" NewServer = "\\server_new\share\folder1\folder1.1" If Right(strFilePath, 1) = "\" Then strFilePath = Left(strFilePath, Len(strFilePath) - 1) strFileArr = Split(CreateFileList(objFS.GetFolder(strFilePath),true), vbCr) For i=0 to UBound(strFileArr) If NOT strFileArr(i) = "" then strFileName = strFileArr(i) wscript.echo "--------------------------------------------------" wscript.echo "Processing File: " & strFilename Set objDoc = objWord.Documents.Open(strFileName) Set objTemplate = objDoc.AttachedTemplate Set dlgTemplate = objWord.Dialogs(wdDialogToolsTemplates) strPath = dlgTemplate.Template wscript.echo "Old Template Name: " & strPath '// Only process templates based on old server If LCase(Left(strPath, Len(OldServer))) = LCase(OldServer) Then wscript.echo "Template needs to be changed..." objDoc.AttachedTemplate = NewServer & Mid(strPath, Len(OldServer) + 1) wscript.echo "New Template Name: " & NewServer & Mid(strPath, Len(OldServer) + 1) End If objDoc.Save objDoc.Close wscript.echo "--------------------------------------------------" wscript.echo "" End If Next Set objDoc = Nothing Set objTemplate = Nothing Set dlgTemplate = Nothing '// Close Word objWord.Quit (False) '______________________FUNCTIONS & SUB ROUTINES_______________________ Function CreateFileList(objFolder, bRecursive) '// <summary> '// Creates a List containing all Files '// </summary> '// <param name="objFolder">Root-Folder for searching</param> '// <param name="bRecursive">Search recursive</param> Dim objFile, objSubFolder For each objFile in objFolder.Files If Right(lcase(objFile),4) = ".doc" OR Right(lcase(objFile),5) = ".docx" AND NOT Left(objFile.Name,1) = "~" then CreateFileList = CreateFileList & objFile.Path & vbCr End If Next If bRecursive = true then For each objSubFolder in objFolder.Subfolders CreateFileList = CreateFileList & CreateFileList(objSubFolder, true) Next End If End Function