asked on

VB SCript to Change MS Word Document Template Location

Here is my problem I have a number of user on my network who have saved local copies of files that contain a document template reference to a very old server location which no longer exist. I need to have a script can this location from \\]old server path to nothing I just want to leave this field blank. I have tried the following VBS script but it keeps saying I have errors in linke 3 and 5 please help. I'm not a vb expert by no means...

Sub word1()

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 = "\\server\company.dot"

nServer = Len()

strFilePath = InputBox("c:\*.*")

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, 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

GrahamSkan

You seem to be quite close.
This code is a little more ambitious in that it will process the whole folder structure beneath the one specified.
I would advise the setting up of a dummy for the old server, otherwise it will run extremely slowly.

Sub ChangeTemplates()
  FindFiles "C:\DocumentFolders", "*.doc"
End Sub
 
Sub FindFiles(strFolder As String, strFilePattern As String)
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
   
    'collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop
   
    'process files in current folder
    strFileName = Dir$(strFolder & "\" & strFilePattern)
    Do Until strFileName = ""
            DoEvents
            Documents.Open strFolder & "\" & strFileName
            If ActiveDocument.AttachedTemplate.path = "\\Oldserver\templates\" Then
                'ActiveDocument.AttachedTemplate = "\\NewServer\templates\" & ActiveDocument.AttachedTemplate.Name
                ActiveDocument.AttachedTemplate = NormalTemplate"
ActiveDocument.Close wdSaveChanges
            Else
                ActiveDocument.Close wdDoNotSaveChanges
            End If
        strFileName = Dir$()
    Loop
   
    'look through child folders
    For i = 0 To iFolderCount - 1
        FindFiles strFolders(i), strFilePattern
    Next i
End Sub

Open in new window

compdigit44

ASKER

Ok I just copied and paste your code and changed my older name and left me new server name blank since I do not have a template to use here any more. Any way it states that I'm missing a ) at line 5, PLease help

Sub ChangeTemplates()
FindFiles "C:\DocumentFolders", "*.doc"
End Sub

Sub FindFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim i As Integer

'collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop

'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
DoEvents
Documents.Open strFolder & "\" & strFileName
If ActiveDocument.AttachedTemplate.path = "\\AP06templates and samples\purchase order request.dot" Then
'ActiveDocument.AttachedTemplate = "" & ActiveDocument.AttachedTemplate.Name
ActiveDocument.AttachedTemplate = NormalTemplate"
ActiveDocument.Close wdSaveChanges
Else
ActiveDocument.Close wdDoNotSaveChanges
End If
strFileName = Dir$()
Loop

'look through child folders
For i = 0 To iFolderCount - 1
FindFiles strFolders(i), strFilePattern
Next i
End Sub
Open in New Window

GrahamSkan

I must admit that it is some old code that I haven't tested today. I'm not in a position to do that at the moment.

It seems that when I commented out the new server line and added the line specifying the Normal template I left a pair of double quotation marks at the end of the line (31 in the snippet).

I can't see why it gives the error that you report, though. Try removing the quotes and see what happens.

GrahamSkan

Just a point of clarification. You are running this as a Word macro, and not modifying it to VBScript as the question title, and your mention of an error on a particular line number would suggest. Is that right?

compdigit44

ASKER

I did know that I have been saving this code as a VBS on my deskto and trying to run it from there...

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

compdigit44

ASKER

can i push this out via group policy. becuase my users are going to get lost doing this them selves

GrahamSkan

Probably, but I don't know much about group policy. I've never used it.

The code could be put in a separate template (not the Normal template that I just recommended), perhaps with a toolbar button, and distributed to users' Word StartUp folders.