+ Post New Thread
Results 1 to 12 of 12
Scripts Thread, VBA Script to change word document template location in Coding and Web Development; HI, We recently moved our Workgroup Templates for Word to a new file server in anticipation of shutting down the ...
  1. #1
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18

    VBA Script to change word document template location

    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

  2. #2
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18
    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

  3. #3
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18

    [SOLVED] - change Word Document Template recursively

    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

  4. #4

    Join Date
    Jul 2011
    Posts
    1
    Thank Post
    0
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    Hi

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

  5. #5
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18
    Just make sure you have installed the Office Group Policy ADM templates on your servers (you download them from Microsoft...)

  6. #6

    Join Date
    Oct 2011
    Posts
    2
    Thank Post
    0
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    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!

  7. #7
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18
    Doesn't my code in post #3 work for you?

    Jon

  8. #8

    Join Date
    Oct 2011
    Posts
    2
    Thank Post
    0
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    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!

  9. #9
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18
    Quote Originally Posted by coffeeguy View Post
    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

  10. #10

    Join Date
    Aug 2013
    Posts
    1
    Thank Post
    0
    Thanked 0 Times in 0 Posts
    Rep Power
    0
    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

  11. #11
    markcuk's Avatar
    Join Date
    Sep 2005
    Posts
    586
    Thank Post
    29
    Thanked 60 Times in 55 Posts
    Rep Power
    38

  12. #12
    jonwitts's Avatar
    Join Date
    Dec 2006
    Location
    England
    Posts
    132
    Thank Post
    17
    Thanked 12 Times in 11 Posts
    Blog Entries
    1
    Rep Power
    18
    Quote Originally Posted by Patrik View Post
    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

SHARE:
+ Post New Thread

Similar Threads

  1. [MS Office - 2007] password protect a word document
    By RabbieBurns in forum Office Software
    Replies: 9
    Last Post: 21st March 2009, 10:01 AM
  2. [MS Office - 2003] Word document recovery
    By Griffo in forum Office Software
    Replies: 1
    Last Post: 7th January 2009, 12:44 PM
  3. [MS Office - 2003] Printing Serial number on word document.
    By maniac in forum Office Software
    Replies: 1
    Last Post: 26th September 2008, 02:37 PM
  4. Error trying to change link location
    By rush_tech in forum EduGeek Joomla 1.5 Package
    Replies: 1
    Last Post: 20th May 2008, 10:19 PM
  5. change the default save as location.
    By ozzy in forum How do you do....it?
    Replies: 4
    Last Post: 6th December 2007, 02:36 PM

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •