Obrir, reemplaçar, desar i tancar amb OpenOffice.org Basic i amb VisualBasic

Aquesta setmana passada un conegut em va demanar el següent: en un full d'excel tenia, en la primera columna un prefix, i en la segona un nom. Es tractava de, per a cada prefix de la primera columna, fer una copia d'un document word a una carpeta de destinació  donant-li de nom, el prefix corresponent, més una part fixa. A continuació, calia substituir dins del document, un text determinat pel nom respectiu de la segona columna.

De fet, això no és més que la combinació d'un text amb una taula i no és res que no es vingui fent des de temps immemorials. Poc o molt tots els  processadors de text disposen d'una opció de combinació per a fer, per exemple, emailings.

En tot cas el conegut aquest partia d'un full Excel i d'un fitxer Word i no semblava disposat a investigar en els misteris de la combinació de documents. Així que em va demanar si el podia ajudar. Realment, el problema no acabava d'adaptar-se exactament a la  combinació de documents per a correspondència, així que em va semblar que era una bona ocasió per a exercitar-me amb les macros d'Excel i Word.

Doncs bé, vet aquí l'esquema general de la solució que li vaig donar. Vaig fer una macro amb excel. Va ser necessari incloure les referències als documents de MSWord per a poder utilitzar-ne els objectes. El procés general era executar primer la creació dels documents i, a continuació, la substitució.
També hauria pogut fer-ho tot d'una tacada.

Suposarem aquest full excel:

Prefix	Nom
pre1	Substitut 1
pre2	Substitut 2
pre3	Substitut 3
pre4	Substitut 4
pre5	Substitut 5

i el següent doc. word: plantilla.doc

Això és un experiment.
Es tracta de substituir #NOM# per un text que tinc al Calc
I fer-ne un munt de còpies.

A continuació, les macros d'Excel en Visual Basic. Primer de tot, ubico la plantilla.doc a la carpeta C:\fitxers\
També creo la carpeta de destinació C:\fitxers\copies

' Generar els fitxers
Sub generarFitxers()
Dim sFitxer As String
Dim i As Integer
Dim fs As Object
Dim sPathBase As String
Dim sPrefix As String


' crea un objecte FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")
sPathBase = "C:\fitxers\"


For i = 3 To 22
sPrefix = Hoja1.Cells(i, 1)
Debug.Print sPrefix
fs.CopyFile sPathBase & "plantilla.doc", sPathBase & "copies\" & sPrefix & "copia.doc"
Next
End Sub




' A cada un dels fitxers generats, fa la substitució de #NOM# pel text de la columna 2
Sub Substitucio1()
Dim sFitxer As String
Dim i As Integer
Dim wrdApp As Word.Application 'Object
Dim wrdDoc As Word.Document
Dim wrdContent As Word.Range
Dim wrdSelection As Word.Selection
Dim sPathBase As String
Dim sPrefix As String
Dim sSubstitucio As String


sPathBase = "C:\fitxers\"


For i = 3 To 7
sPrefix = Hoja1.Cells(i, 1)
sSubstitucio = Hoja1.Cells(i, 2)
Debug.Print sPrefix
Set wrdApp = New Word.Application
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(sPathBase & "copies\" & sPrefix & "copia.doc")
Set wrdContent = wrdDoc.Content
FindReplace wrdContent, "#NOM#", sSubstitucio
wrdDoc.Save
Set wrdContent = Nothing
Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing
Next


Debug.Print "fet!"


Set wrdApp = Nothing
End Sub


Sub FindReplace(wrdContent As Word.Range, sOriginal As String, sSubstitut As String)
'- FIND & REPLACE
wrdContent.Find.ClearFormatting
wrdContent.Find.Replacement.ClearFormatting
With wrdContent.Find
.Text = sOriginal
.Replacement.Text = sSubstitut
.Forward = True
.Wrap = wdFindContinue
.Format = Falsei
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wrdContent.Find.Execute Replace:=wdReplaceAll
End Sub

Doncs bé, això mateix es pot fer amb OpenOffice.org (o LibreOffice, si ja heu fet el canvi). El plantejament és molt similar. Creo una macro a OpenOffice.org Calc (el full de càlcul) que copiarà un document d'OpenOffice.org Writer a una carpeta de destinació per cada fila de la columna de prefixes. Per a cada copia, l'obrirà, reemplaçarà #NOM# pel valor corresponent de la columna 2, desarà els canvis i tancarà. Vet aquí el codi:

Sub Main
    Dim sPathBase as String


    sPathBase = "/home/albert/fitxers/"


    generarFitxers(sPathBase)
    msgbox "Creats els fitxers"
    Substitucio(sPathBase) d'
    msgbox "Substitució realitzada"
End Sub


' genera els fitxers de plantilla
Sub generarFitxers(sPathBase as String )
    Dim sFitxer As String
    Dim i As Integer
    Dim sPrefix As String


    sPrefix = ""


    For i = 2 To 6
        sPrefix = ThisComponent.Sheets.getByName("Full1").GetCellByPosition(0,i).String
        if Not FileExists("file://" & sPathBase & "prova") then
        MkDir( sPathBase & "prova")
        end if
        FileCopy sPathBase & "plantilla.odt", sPathBase & "copies/" & sPrefix & "copia.odt"
    Next


End Sub


' A cada un dels fitxers generats, fer una substitució total
Sub Substitucio(sPathBase as String)
    Dim sFitxer As String
    Dim i As Integer
    Dim sPrefix As String
    Dim sNomFitxer as String
    Dim sUrlNomFitxer as String
    Dim sNomNou As String
    Dim docWriter as Object


    For i = 2 To 6
        sPrefix = ThisComponent.Sheets.getByName("Full1").GetCellByPosition(0,i).String
        sNomNou = ThisComponent.Sheets.getByName("Full1").GetCellByPosition(1,i).String
        sNomFitxer = sPathBase & "prova/" & sPrefix & "copiaplantilla.odt"
        sUrlNomFitxer = convertToUrl(sNomFitxer)
        docWriter = starDeskTop.loadComponentFromUrl (sUrlNomFitxer, "_blank", 0, Array())
        FindReplace docWriter, "#NOM#",sNomNou
        docWriter.storeAsURL(sUrlNomFitxer, Array())
        docWriter.Close (True)storeAsURL
    Next
End Sub


' cerca i substitueix text
Sub FindReplace(objDoc as Object, sOriginal As String, sSubstitut As String)
    dim objReplace as Object


    objReplace = objDoc.createReplaceDescriptor
    objReplace.SearchRegularExpression = True
    objReplace.SearchString = sOriginal
    objReplace.ReplaceString = sSubstitut


    objDoc.replaceAll(objReplace)
End Sub


Destacaria com en OOoBasic, el tractament de fitxers està incorporat al llenguatge, a diferència del VBA en el que cal invocar un objecte FileSystemObject.
També, el diferent accés a les cel·les en OOoBAsic (GetCellByPosition) i en VBA (Cells).
Molt important: en OOoBasic, degut a que es tracta d'un aplicatiu multiplataforma,  és necessari convertir el nom dels fitxers a una forma d'URL neutral. Això es fa amb ConvertToURL.
La càrrega del fitxer, en OOoBasic es fa amb StarDesktop.LoadComponentFromURL. En canvi, a VBA faig new Word.Application
La cerca i substitució dins del fitxer de text és sensiblement diferent entre  OOoBAsic i VBA.
Finalment, guardar i sortir , en OOoBAsic es fa a partir de mètodes de l'objecte Document (StoreAsURL, per desar, i Close, per tancar. A VBA, en canvi, desar es fa amb un mètode de l'objecdte del document, Save, i sortir, de l'objecte de d'aplicació, Quit.