Avatar of Simon Cox
Simon Cox
Flag for United Kingdom of Great Britain and Northern Ireland asked on

updating document template location in bulk

Hi There, We have done a server migration, and copied over all the data, though unfortunately have come across a little bit of a snag when opening word documents.

Most if not all our documents use a document template. When opening one of these document's, it comes up with "Contacting: \\oldserver\bla\bla\bla\" on the splash screen for about 1-2 minutes before letting you in.

Is there a way of bulk updating the document template location as the thought of updating 5000 documents makes me want to jump off a cliff!!! ;)

Cheers
Microsoft Word

Avatar of undefined
Last Comment
Simon Cox

8/22/2022 - Mon
Stacy Brown

I found this VBA code here:  http://www.edugeek.net/forums/scripts/35199-vba-script-change-word-document-template-location.html

It looks like what you are looking for.  I hope it helps.

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

Open in new window

GrahamSkan

There are several answers on this forum, e.g. here:

https://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Word/Q_22642821.html

The code is similar, but a bit simpler, and there in no 'On Error Resume Next'.

Note that the code will run faster if a server of the old name can be found on the network. It doesn't need the old file structure.
ASKER CERTIFIED SOLUTION
Simon Cox

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
GrahamSkan

Thanks for that information. It will often be the better solution.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Simon Cox

ASKER
easiest fix for this particular issue