My Tech Scrap
Flipkart.com

Translate

Saturday, 6 February 2010

Documents that have attached templates take a long time to open in Word 2002 and in Word 2003

When you open a Microsoft Word Document (*.doc) file, the document may take longer then expected to open. For example, the document may take 5 to 10 minutes to open.
Back to the top
CAUSE
This symptom may occur if the document has a template attached or linked and one of the following conditions is true: The attached template, its folder, or its share is missing.
The attached template has been moved.
The attached template has been renamed.
The attached template, its folder, or its share is missing.
The attached template has been moved.
The attached template has been renamed.
When a Word template is missing, Windows XP will try to locate the missing template multiple times. The process of locating a missing template may cause a Word document to take longer than expected to open.

It will take longer to open the document when you are connected to a network compared to when you are disconnected from the network.
Back to the top
RESOLUTION
To work around this problem on a computer with Windows XP installed, use one of the following methods as appropriate for your situation: Method 1: Attach the template from a new location, or attach the global template (Normal.dot).

Tools >> Templates and Add-In.. >>Change the  value "Document Template"  field to "Normal.dot"

For more than one file you can use VBscript too
Refer this link for more details
http://support.microsoft.com/?kbid=830561
















































































































































Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public fso As New FileSystemObject
Dim fld As Folder

Private Sub cmdEnd_Click()
End
End Sub

Private Sub cmdSource_Click()
' Opens a Treeview control that displays the directories in a computer.

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
frmFSO.txtSearch.Text = sBuffer
End If
End Sub

Private Sub cmdTarget_Click()

' Opens a Treeview control that displays the directories in a computer.

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Sub

Private Sub Command1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
Dim nTime
Dim ntime2
Dim nOk As Integer
Dim fileNumber As Integer
Dim oWord As Object
Dim strServer As String
Set oWord = CreateObject("Word.Application")
strServer = txtOldServer.Text
nTime = Time()
fileNumber = FreeFile

List1.Clear

Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, "Start:" & " " & nTime
Close #fileNumber

'Enter the top-level directory to start the search.
sDir = txtSearch.Text

'Enter the type of files, such as *.doc for Word documents
sSrchString = "*.doc"

MousePointer = vbHourglass

'The label shows the current subfolder being searched.
Label1.Caption = "Searching Folder: " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles, strServer, oWord)
MousePointer = vbDefault
ntime2 = Time()
'Opens text file to show the stop time and the total numbers of
'files that were found.
Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, "Stop:" & " " & ntime2 & " " & _
"Time to Complete the Changes: " & _
Format(ntime2 - nTime, "nn:ss") & vbCrLf _
& Str(nFiles) & " files found in" & Str(nDirs) & _
" directories"
Close #fileNumber
' Debug.Print "Stop:" & " " & ntime2
Label1.Caption = "Done"
If Label1.Caption = "Done" Then Command2.Enabled = True
MsgBox "Done"
oWord.Quit
Set oWord = Nothing
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long, strOServer As String, oWrd As Object) _
As Currency
Dim tFld As Folder, tFil As File, FileName As String
Dim strFileName As String
Dim fileNumber As Integer

On Error GoTo Catch

Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
nFiles = nFiles + 1
List1.AddItem fso.BuildPath(fld.Path, FileName) ' Load ListBox
strFileName = fld.Path & "\" & FileName
'==

ChangeTemplate strFileName, strOServer, oWrd
FileName = Dir() ' Get next file
DoEvents
Wend
Label1 = "Searching " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1

If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, _
strOServer, oWrd)
Next
End If
Exit Function

Catch: FileName = ""

If Err.Number = 76 Then
MsgBox "This is not a valid path statement" & vbCrLf & _
"The program will end!"
End
End If
Debug.Print Err.Description
fileNumber = FreeFile

'Writes the error description and number to the log file.
Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, Err.Description & " " & Err.Number
Close #fileNumber
Resume Next
End Function

Private Sub Command2_Click()
'Use this to view the log file.
Shell "notepad.exe c:\ChangeTemplate.log", 1
End Sub



























































































































































































In a Standard module, add the following code:Sub ChangeTemplate(SourceFile As String, strServer As String, objWord As Object)

Dim dlgTemplates As Dialog
Dim strTemp As String
Dim strpath As String
Dim objtemplate As String
Dim dlgTemplate As Object
Dim x As Integer
Dim fNumber As Integer
Dim objDoc As Object

fNumber = FreeFile

objWord.Visible = False
strTemp = SourceFile

'This function determines if the document is password protected or Read Only.
If OpenDocument(objWord, strTemp) = True Then
'This assumes that there is only one document opened. It may have to be adjusted
'to look for additional document being opened.
Set objDoc = objWord.Documents(1)
'Dialogs 87 is the Templates and Addins dialog
Set dlgTemplates = objWord.Dialogs(87)
objtemplate = objWord.Dialogs(87).Template

'parse out the server name from the fullname of the attached template

If Mid(objtemplate, 2, 1) = ":" Or Left(objtemplate, 2) = "\\" Then
x = InStr(3, objtemplate, "\")
strTemp = Mid(objtemplate, 3, x - 3)
'if the parse name is the same as the stated server then
'change the attached template to the Normal

If strTemp = strServer Then
objDoc.AttachedTemplate = "Normal.dot"
'write to a log file the file name and location
Open "C:\ChangeTemplate.log" For Append As #fNumber
Write #fNumber, "Document: " & objDoc.fullName & _
"Attached template changed to Normal.dot"
Close #fNumber
End If
End If

'After the template is changed, the document is saved and closed.

objDoc.Save
objDoc.Close
Else
'Enter into the log file files that are not opened.
Open "C:\ChangeTemplate.log" For Append As #fNumber
Write #fNumber, "Document: " & SourceFile & " not opened! it's
Read Only or Password Protected"
Close #fNumber
End If

End Sub
Function OpenDocument(ByRef objWord As Object, ByVal sDoc As String) As Boolean
'Arguments:
' objWord - a valid Word Application object.
' sDoc - the complete path and file name of the document to open in Word.
'
'Opens the document specified by the sDoc variable.
'This function returns True if the document is opened and is read/write.
'Else, this function returns False if the document cannot be opened
'or if the document is opened read-only because of the "read-only recommended" setting
'in the document.
'Therefore only if this function returns True if you try to modify the document.
'If False is returned, log the sDoc into a text file and alert the user
'of the list of file(s) that could not be processed by the batch routine.
On Error GoTo EH
Dim oDoc As Object
Set oDoc = objWord.Documents.Open( _
FileName:=sDoc, _
ReadOnly:=False, _
PasswordDocument:="?#nonsense@$", _
WritePasswordDocument:="?#nonsense@$")
If oDoc.ReadOnly = True Then
OpenDocument = False
Else
OpenDocument = True
End If
CleanUp:
On Error Resume Next
Set oDoc = Nothing
Exit Function

EH:
'There was an error opening the file. Return False
OpenDocument = False
Resume CleanUp
End Function

















































































































































































































































































Open a new Standard.exe project.
On a User Form, add the following components: One list box
Two text boxes
Four command buttons
Two labels
One list box
Two text boxes
Four command buttons
Two labels
Set a reference to the Microsoft Scripting Runtime (Scrun.dll).
Copy and paste the following code in a user form:Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public fso As New FileSystemObject
Dim fld As Folder

Private Sub cmdEnd_Click()
End
End Sub

Private Sub cmdSource_Click()
' Opens a Treeview control that displays the directories in a computer.

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
frmFSO.txtSearch.Text = sBuffer
End If
End Sub

Private Sub cmdTarget_Click()

' Opens a Treeview control that displays the directories in a computer.

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Sub

Private Sub Command1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
Dim nTime
Dim ntime2
Dim nOk As Integer
Dim fileNumber As Integer
Dim oWord As Object
Dim strServer As String
Set oWord = CreateObject("Word.Application")
strServer = txtOldServer.Text
nTime = Time()
fileNumber = FreeFile

List1.Clear

Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, "Start:" & " " & nTime
Close #fileNumber

'Enter the top-level directory to start the search.
sDir = txtSearch.Text

'Enter the type of files, such as *.doc for Word documents
sSrchString = "*.doc"

MousePointer = vbHourglass

'The label shows the current subfolder being searched.
Label1.Caption = "Searching Folder: " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles, strServer, oWord)
MousePointer = vbDefault
ntime2 = Time()
'Opens text file to show the stop time and the total numbers of
'files that were found.
Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, "Stop:" & " " & ntime2 & " " & _
"Time to Complete the Changes: " & _
Format(ntime2 - nTime, "nn:ss") & vbCrLf _
& Str(nFiles) & " files found in" & Str(nDirs) & _
" directories"
Close #fileNumber
' Debug.Print "Stop:" & " " & ntime2
Label1.Caption = "Done"
If Label1.Caption = "Done" Then Command2.Enabled = True
MsgBox "Done"
oWord.Quit
Set oWord = Nothing
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long, strOServer As String, oWrd As Object) _
As Currency
Dim tFld As Folder, tFil As File, FileName As String
Dim strFileName As String
Dim fileNumber As Integer

On Error GoTo Catch

Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
nFiles = nFiles + 1
List1.AddItem fso.BuildPath(fld.Path, FileName) ' Load ListBox
strFileName = fld.Path & "\" & FileName
'==

ChangeTemplate strFileName, strOServer, oWrd
FileName = Dir() ' Get next file
DoEvents
Wend
Label1 = "Searching " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1

If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, _
strOServer, oWrd)
Next
End If
Exit Function

Catch: FileName = ""

If Err.Number = 76 Then
MsgBox "This is not a valid path statement" & vbCrLf & _
"The program will end!"
End
End If
Debug.Print Err.Description
fileNumber = FreeFile

'Writes the error description and number to the log file.
Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, Err.Description & " " & Err.Number
Close #fileNumber
Resume Next
End Function

Private Sub Command2_Click()
'Use this to view the log file.
Shell "notepad.exe c:\ChangeTemplate.log", 1
End Sub



























































































































































































Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public fso As New FileSystemObject
Dim fld As Folder

Private Sub cmdEnd_Click()
End
End Sub

Private Sub cmdSource_Click()
' Opens a Treeview control that displays the directories in a computer.

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
frmFSO.txtSearch.Text = sBuffer
End If
End Sub

Private Sub cmdTarget_Click()

' Opens a Treeview control that displays the directories in a computer.

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Sub

Private Sub Command1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
Dim nTime
Dim ntime2
Dim nOk As Integer
Dim fileNumber As Integer
Dim oWord As Object
Dim strServer As String
Set oWord = CreateObject("Word.Application")
strServer = txtOldServer.Text
nTime = Time()
fileNumber = FreeFile

List1.Clear

Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, "Start:" & " " & nTime
Close #fileNumber

'Enter the top-level directory to start the search.
sDir = txtSearch.Text

'Enter the type of files, such as *.doc for Word documents
sSrchString = "*.doc"

MousePointer = vbHourglass

'The label shows the current subfolder being searched.
Label1.Caption = "Searching Folder: " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles, strServer, oWord)
MousePointer = vbDefault
ntime2 = Time()
'Opens text file to show the stop time and the total numbers of
'files that were found.
Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, "Stop:" & " " & ntime2 & " " & _
"Time to Complete the Changes: " & _
Format(ntime2 - nTime, "nn:ss") & vbCrLf _
& Str(nFiles) & " files found in" & Str(nDirs) & _
" directories"
Close #fileNumber
' Debug.Print "Stop:" & " " & ntime2
Label1.Caption = "Done"
If Label1.Caption = "Done" Then Command2.Enabled = True
MsgBox "Done"
oWord.Quit
Set oWord = Nothing
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long, strOServer As String, oWrd As Object) _
As Currency
Dim tFld As Folder, tFil As File, FileName As String
Dim strFileName As String
Dim fileNumber As Integer

On Error GoTo Catch

Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
nFiles = nFiles + 1
List1.AddItem fso.BuildPath(fld.Path, FileName) ' Load ListBox
strFileName = fld.Path & "\" & FileName
'==

ChangeTemplate strFileName, strOServer, oWrd
FileName = Dir() ' Get next file
DoEvents
Wend
Label1 = "Searching " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1

If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, _
strOServer, oWrd)
Next
End If
Exit Function

Catch: FileName = ""

If Err.Number = 76 Then
MsgBox "This is not a valid path statement" & vbCrLf & _
"The program will end!"
End
End If
Debug.Print Err.Description
fileNumber = FreeFile

'Writes the error description and number to the log file.
Open "C:\ChangeTemplate.log" For Append As #fileNumber
Write #fileNumber, Err.Description & " " & Err.Number
Close #fileNumber
Resume Next
End Function

Private Sub Command2_Click()
'Use this to view the log file.
Shell "notepad.exe c:\ChangeTemplate.log", 1
End Sub



























































































































































































In a Standard module, add the following code:Sub ChangeTemplate(SourceFile As String, strServer As String, objWord As Object)

Dim dlgTemplates As Dialog
Dim strTemp As String
Dim strpath As String
Dim objtemplate As String
Dim dlgTemplate As Object
Dim x As Integer
Dim fNumber As Integer
Dim objDoc As Object

fNumber = FreeFile

objWord.Visible = False
strTemp = SourceFile

'This function determines if the document is password protected or Read Only.
If OpenDocument(objWord, strTemp) = True Then
'This assumes that there is only one document opened. It may have to be adjusted
'to look for additional document being opened.
Set objDoc = objWord.Documents(1)
'Dialogs 87 is the Templates and Addins dialog
Set dlgTemplates = objWord.Dialogs(87)
objtemplate = objWord.Dialogs(87).Template

'parse out the server name from the fullname of the attached template

If Mid(objtemplate, 2, 1) = ":" Or Left(objtemplate, 2) = "\\" Then
x = InStr(3, objtemplate, "\")
strTemp = Mid(objtemplate, 3, x - 3)
'if the parse name is the same as the stated server then
'change the attached template to the Normal

If strTemp = strServer Then
objDoc.AttachedTemplate = "Normal.dot"
'write to a log file the file name and location
Open "C:\ChangeTemplate.log" For Append As #fNumber
Write #fNumber, "Document: " & objDoc.fullName & _
"Attached template changed to Normal.dot"
Close #fNumber
End If
End If

'After the template is changed, the document is saved and closed.

objDoc.Save
objDoc.Close
Else
'Enter into the log file files that are not opened.
Open "C:\ChangeTemplate.log" For Append As #fNumber
Write #fNumber, "Document: " & SourceFile & " not opened! it's
Read Only or Password Protected"
Close #fNumber
End If

End Sub
Function OpenDocument(ByRef objWord As Object, ByVal sDoc As String) As Boolean
'Arguments:
' objWord - a valid Word Application object.
' sDoc - the complete path and file name of the document to open in Word.
'
'Opens the document specified by the sDoc variable.
'This function returns True if the document is opened and is read/write.
'Else, this function returns False if the document cannot be opened
'or if the document is opened read-only because of the "read-only recommended" setting
'in the document.
'Therefore only if this function returns True if you try to modify the document.
'If False is returned, log the sDoc into a text file and alert the user
'of the list of file(s) that could not be processed by the batch routine.
On Error GoTo EH
Dim oDoc As Object
Set oDoc = objWord.Documents.Open( _
FileName:=sDoc, _
ReadOnly:=False, _
PasswordDocument:="?#nonsense@$", _
WritePasswordDocument:="?#nonsense@$")
If oDoc.ReadOnly = True Then
OpenDocument = False
Else
OpenDocument = True
End If
CleanUp:
On Error Resume Next
Set oDoc = Nothing
Exit Function

EH:
'There was an error opening the file. Return False
OpenDocument = False
Resume CleanUp
End Function


















































































































































































































































































back to the top
Back to the top
Method 3: Create a Microsoft Visual Basic for Applications (VBA) macro that loops through all the documents in a folder and changes the old server name with the new server name
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure. However, they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.

The following macro loops through all the documents in a folder and changes the old server name with the new server name for the location of the templates. This macro works only if the path for the templates is the same.Sub Test()
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 = "<\\rsnj01\vol1>"
NewServer = "<\\rsnyc1p\vol3>"
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, 13)) = LCase(OldServer) Then
objDoc.AttachedTemplate = NewServer & Mid(strPath, 14)
End If
strFileName = Dir()
objDoc.Save
objDoc.Close
Loop
Set objDoc = Nothing
Set objTemplate = Nothing
Set dlgTemplate = Nothing

End Sub




































































































back to the top
Back to the top
Method 4: Create a VBA macro that loops through all the documents in a folder and changes the old server name with the global template (Normal.dot )
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure. However, they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.

The following macro loops through all the documents in a folder and changes the old server name with the global template (Normal.dot ).

Note If a document is password protected in anyway, the template will not be changed and the code will fail.
Sub Test()



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



'hardcode the name of the old server.



OldServer = "{enter the name of the Old Server}"

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

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


back to the top
Back to the top
Method 5: Rename the server, the share, or the folder to the original name
If the server, the share, or the folder that contains the template was moved or renamed, rename the server, the share, or the folder back to the original name.

If OLD server does not exist anymore, you can create DNS entry with OLD servername. Once you have the OLD servername DNS entry, you can create the same folder structure as listed in template path and copy the template to that folder.

No comments:

Post a Comment