During most of my Infrastructure and Migration projects, most customers have the same issue. After migrating the file data to a new server, old documents may try to access their original document template on which they are based on.
Unfortunately, the referenced path is not a mapped network drive or a relative path – it is a UNC Path containing the old server name.
Therefore, I wrote a little script that will process all Word Documents within a given path and replace the old Server and or Share name with the new ones. After that, the launch of these old documents will be much faster.
You need write permissions to all Word Documents which should be changed and of course you need to have Microsoft Word (I used Word 2010) installed:
' ##################################################################### ' ## ' ## (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:Usersmichaeldesktop" OldServer = "vv" NewServer = "OLD-FILESERVERsharefolder1" 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> '//Root-Folder for searching '//Search recursive 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