El cafè antic

L’altra dia a la feina em va sorgir la necessitat de canviar la plantilla de tot un conjunt de documents de Word. Sabeu que Word guarda la plantilla (si és diferent de Normal.dot) a l’interior del document. Si aquesta ruta ja no existeix, heu canviat els documents de banda o bé ja no hi tenen permisos els vostres usuaris us pot donar una bona estona de maldecap investigar perquè carall triguen a obrir-se els documents de Word (sobretot si treballeu en xarxa). Per tal de solucionar això he creat un codi en VBA (Visual Basic for Applications) que podeu posar en un mateix arxiu de Word com a macro o bé com a codi VisualBasic i executar-lo per tal de canviar totes les plantilles de tants documents com vulgueu.

L’esquema de procés és senzill. Donada una ruta de la que pengen directoris amb documents de Word i d’altres, el programet agafarà cada directori i cercarà tots els documents de Word que hi siguin continguts i en reemplaçarà la plantilla que hi hagi per la que nosaltres haguem designat.

Això ens serà de molta utilitat quan tenim uns quants documents a canviar, per això en poso el codi a disposició vostra:
Sub CanviaPlantilles()
‘ Inicialització de variables
Dim strDocPath As String
Dim strTemplateB As String
Dim strCurDoc, ruta As String
Dim docCurDoc As Document
Dim oFso As Object
Dim oFolder
Dim oSubFolder

‘ Definició de la ruta on es troben els documents
strDocPath = “c:\rutadelsdocuments”
‘ Definició de la ruta on es troba la nova plantilla
strTemplateB = “c:\plantilla.dot”

‘ Trobem el primer directori dins del directori on volem cercar documents

Set oFso = CreateObject(”Scripting.FileSystemObject”)
Set oFolder = oFso.getfolder(strDocPath)

‘Per cada subdirectori, hem de fer…

‘MsgBox oSubFolder.Name

‘ Si el nom del directori <> . o .. llavors
If (oSubFolder.Name <> “.” And oSubFolder.Name <> “..”) Then

‘ Ruta actual on buscar els documents

ruta = strDocPath + oSubFolder.Name + “\”

strCurDoc = Dir(ruta & “*.doc”)
Do While strCurDoc <> “”
‘ obro el document de word
Set docCurDoc = Documents.Open(FileName:=ruta & strCurDoc)
‘ canvio la plantilla
docCurDoc.AttachedTemplate = strTemplateB
‘ guardo i tanco
docCurDoc.Close wdSaveChanges
‘ anem pel seguent

strCurDoc = Dir
Loop
End If

Next

‘ Missatge de finalització

MsgBox “Procés Acabat!”
End Sub