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