VBA Script to change word document template location

[jonwitts]

HI,

 

We recently moved our Workgroup Templates for Word to a new file server in anticipation of shutting down the old file server for good. We successfully changed the loaction of the Workgroup templates in Microsoft Office with GP, and replicated the file share to the new server. We then shut the server down for good.

 

Now comes the fun part! All of the documents that were created from any of the workgroup templates on the old server still reference the old server in the document template setting. This is slowing the loading time of these documents right down and casuing masses of uneccessary network traffic.

 

I have read this VBA Macro script on Microsoft's site ( Documents that have attached templates take a long time to open in Word 2002 and in Word 2003 ), method 3; but can not get it to work...

 

Can anyone see where I am going wrong?

 

Cheers

 

Jon

 

------------------------------------------

 

Sub rename_temp_dir()

Dim strFilePath As String

Dim strPath As String

Dim intCounter As Integer

Dim strFileName As String

Dim OldServer As String

Dim NewServer As String

Dim objDoc As Document

Dim objTemplate As Template

Dim dlgTemplate As Dialog

 

OldServer = "<\\server>"

NewServer = "<\\south_hunsley>"

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, 8)) = LCase(OldServer) Then

objDoc.AttachedTemplate = NewServer & Mid(strPath, 9)

End If

strFileName = Dir()

objDoc.Save

objDoc.Close

Loop

Set objDoc = Nothing

Set objTemplate = Nothing

Set dlgTemplate = Nothing

 

End Sub

[jonwitts]

OK... Found it myself this morning...

 

It was the < > at the start and end of both server names that was throwing it...

 

Here is the working version...

 

Now all I need to do is get it to read through sub folders too...

 

---------------

 

Sub rename_temp_dir()

Dim strFilePath As String

Dim strPath As String

Dim intCounter As Integer

Dim strFileName As String

Dim OldServer As String

Dim NewServer As String

Dim objDoc As Document

Dim objTemplate As Template

Dim dlgTemplate As Dialog

 

OldServer = "\\b091-jonw\templates"

NewServer = "\\south_hunsley\templates"

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, 21)) = LCase(OldServer) Then

objDoc.AttachedTemplate = NewServer & Mid(strPath, 22)

End If

strFileName = Dir()

objDoc.Save

objDoc.Close

 

Loop

Set objDoc = Nothing

Set objTemplate = Nothing

Set dlgTemplate = Nothing

 

End Sub

[jonwitts]

Just in case anyone else needs this at some point; here is the working Macro to recursively change the workgroup template server setting in Word documents...

 

---------------------------------------------------------------------------

 

Sub recursive_rename_temp_dir()

 

On Error Resume Next

 

Dim colFiles As New Collection

Dim strFilePath As String

Dim strFileType As String

Dim strFileName As String

Dim OldServer As String

Dim NewServer As String

Dim objDoc As Document

Dim objTemplate As Template

Dim dlgTemplate As Dialog

 

' Set the name of old and new server here

OldServer = "\\server\templates"

NewServer = "\\south_hunsley\templates"

 

'Message prompt for folder location

strFilePath = InputBox("What is the folder location that you want to use?")

 

'Message prompt for file type

strFileType = InputBox("What is the file extension you are looking for, including the dot?")

 

RecursiveDir colFiles, strFilePath, "*" & strFileType, True

 

Dim vFile As Variant

For Each vFile In colFiles

Debug.Print vFile

 

'vFile returns full file path - split it at the last "\" to get file name

strFilePath = vFile

 

SeparatePathAndFile strFilePath, strFileName

 

Set objDoc = Documents.Open(strFilePath & strFileName)

Set objTemplate = objDoc.AttachedTemplate

Set dlgTemplate = Dialogs(wdDialogToolsTemplates)

strPath = dlgTemplate.Template

 

'first number equals number of characters in OldServer string, second number is incremented by one

If LCase(Left(strPath, 18)) = LCase(OldServer) Then

objDoc.AttachedTemplate = NewServer & Mid(strPath, 19)

End If

 

objDoc.Save

objDoc.Close

 

Next vFile

 

End Sub

 

Private Sub SeparatePathAndFile(ByRef io_strPath As String, ByRef o_strFileName As String)

'io_strPath - Input/output parameter containing the entire path with file name

' - Will Return the path only

'o_strFileName - Output parameter that will contain the name of the File

 

Dim strPath() As String

Dim lngIndex As Long

 

strPath() = Split(io_strPath, "\") 'Put the Parts of our path into an array

lngIndex = UBound(strPath)

o_strFileName = strPath(lngIndex) 'Get the File Name from our array

strPath(lngIndex) = "" 'Remove the File Name from our array

io_strPath = Join(strPath, "\") 'Rebuild our path from our array

 

End Sub

 

Public Function RecursiveDir(colFiles As Collection, _

strFolder As String, _

strFileSpec As String, _

bIncludeSubfolders As Boolean)

 

Dim strTemp As String

Dim colFolders As New Collection

Dim vFolderName As Variant

 

'Add files in strFolder matching strFileSpec to colFiles

strFolder = TrailingSlash(strFolder)

strTemp = Dir(strFolder & strFileSpec)

Do While strTemp <> vbNullString

colFiles.Add strFolder & strTemp

strTemp = Dir

Loop

 

If bIncludeSubfolders Then

'Fill colFolders with list of subdirectories of strFolder

strTemp = Dir(strFolder, vbDirectory)

Do While strTemp <> vbNullString

If (strTemp <> ".") And (strTemp <> "..") Then

If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then

colFolders.Add strTemp

End If

End If

strTemp = Dir

Loop

 

'Call RecursiveDir for each subfolder in colFolders

For Each vFolderName In colFolders

Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)

Next vFolderName

End If

 

End Function

 

 

Public Function TrailingSlash(strFolder As String) As String

If Len(strFolder) > 0 Then

If Right(strFolder, 1) = "\" Then

TrailingSlash = strFolder

Else

TrailingSlash = strFolder & "\"

End If

End If

End Function

[amywoo]

Hi

 

Please could you tell me how you did the Gp part?

Regards

Amy

[jonwitts]

Just make sure you have installed the Office Group Policy ADM templates on your servers (you download them from Microsoft...)

[coffeeguy]

Your post has been very helpful. I have the following code which works for one directory:

 

Sub PointToNormal()

 

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

 

OldServer = InputBox("What is the old path of your template?(full path to file extension)")

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")

strFileName = InputBox("What is the file extension you are looking for, including the dot?")

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

 

Can you help me set this up to parse subfolders that are contained in the FilePath string?

 

Any help would be much appreciated!

[jonwitts]

Doesn't my code in post #3 work for you?

 

Jon

[coffeeguy]

Turns out it may. My I.T. team had restored the path where the templates were. I didn't know this when I was testing. It appears that if the old template path is available you can't update the document. I am going to test this tomorrow morning. As soon as I have some results I will update.

 

I would like to use your code, the only change I would like to is make it point to the normal.dot template instead of a specific path. Like in what I posted. Any suggestions there?

 

By the way thank you for your reply so many people let there threads go unanswered!

[jonwitts]

Turns out it may. My I.T. team had restored the path where the templates were. I didn't know this when I was testing. It appears that if the old template path is available you can't update the document. I am going to test this tomorrow morning. As soon as I have some results I will update.

 

I would like to use your code, the only change I would like to is make it point to the normal.dot template instead of a specific path. Like in what I posted. Any suggestions there?

 

By the way thank you for your reply so many people let there threads go unanswered!

 

I'm not sure I follow you... The script is specifically for replacing the hard coded WORKGROUP TEMPLATE setting in a Word file... I suppose you could try and point all of your workgroup templates at the local Normal.dot file on each machine, but I am not sure what effect that would have on it... I would maybe try replacing the newserver variable with something like "%systemdrive%\%userprofile%\folders structure to local temp files..." but as I say; that comes with no promises and is completely untested, as I am running Linux at home and have no way of testing...

 

You would also need to overwrite the name of the current workgroup template file to be Normal.dot too... but that shouldn't be too hard.

 

Again; not sure why you want to do this.... This script was for a very specific purpose of fixing loads of files that pointed to a non-existent share on a non-existent server... This caused the file (and local PC) to lock up every time the files were opened whilst it broadcast across the whole network trying to find the server...

 

My advise; always share your workgroup template folder out on a DFS share. That way if you replace a server, you can just add the new one into the DFS Share!

 

Good luck anyway!

 

Jon

[Patrik]

Hi, I have the same problem and see that this solution is the only way to help. But I am a VBA newbie and not able to run the script. Can someone put a download here with an complete word document only to run a defined script? This could help for someones like me.

 

Regards,

Patrik

[markcuk]

dont know if this will help Word Template Installer | Computer Technician - PC Repair Software |Foolish IT LLC

[jonwitts]

Hi, I have the same problem and see that this solution is the only way to help. But I am a VBA newbie and not able to run the script. Can someone put a download here with an complete word document only to run a defined script? This could help for someones like me.

 

Regards,

Patrik

@Patrik,

 

Apologies in the delay in responding; does this link help you in creating a Macro? Record or run a macro - Word - Office.com I would upload the Word Document, but you would only have to edit the Macro anyway with your old and new server names; so you would be better off adjusting the provided script and creating the Macro yourself.

 

Jon

[jconstan]

Jon, When I run the macro unfortunately when it opens the document it tries to go to the location of the template, which does not exist any longer and needs to time out before going to the next document. Any ideas on how to make it work without opening every document?

 

Thanks,

Jim

[jonwitts]

@jconstan As far as I know the only to change this is by opening the file... When I ran this I ran it locally on the file server and started it off last thing on Friday and left it running all weekend... It can take some time!

 

Jon