1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
|
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 = "<\\csem.ch\data\CSEM\app\Template>"
NewServer = "<\\srv-n\Data-CSEM\Info\template>"
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
With objDoc
.UpdateStylesOnOpen = False
If LCase(Left(strPath, Len(OldServer))) = LCase(OldServer) Then
.AttachedTemplate = NewServer & Mid(strPath, (Len(OldServer) + 1))
End If
.XMLSchemaReferences.AutomaticValidation = True
.XMLSchemaReferences.AllowSaveAsXMLWithoutValidation = False
End With
strFileName = Dir()
objDoc.Save
objDoc.Close
Loop
Set objDoc = Nothing
Set objTemplate = Nothing
Set dlgTemplate = Nothing
End Sub |
Partager