J'avais besoin de créer automatiquement des fichiers au format ODF basés sur des templates (modèles).
Je devais intégrer ceci dans un système existant en VBScript (au cas où on se demanderait "Pourquoi en vbscript ?")

Je poste ce code s'il s'avère utile à quelqu'un (j'ai failli poster dans "Vos contributions" mais je ne pense que que ce code soit encore suffisamment élégant).
Ce code remplace, dans le template ODF, tous les tags, marqués par des parenthèses {tag}, qu'il trouve dans le "dictionnaire" passé en paramètre.

Ce qui n'est pas top :

  • LibreOffice insère parfois des balises entre les parenthèses et le tag (ce qui rend le code inopérant sur le tag concerné).
  • Le système de fichier est "chatouilleux" sur certaines machines, il faut donc parfois ajuster les temporisations dans les 2 fonctions Zip/Unzip
  • Le traitement des fichiers est fait un peu à la hussarde (et mériterait sans doute un peu plus de sécurité).
  • (et ce que je n'ai pas vu mais qui n'est pas top quand même)

Ce qui manque :

Une itération dans le template (pour faire des tableaux par exemple). J'y réfléchi mais le choix initial du dictionary est bloquant.

Bref, le code fonctionne (chez moi) et je le livre à vos commentaires (pour lesquels je vous remercie déjà).

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
 
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Dim oFso, sCurPath, sSrcFile, sNewFile
 
Set oFso = CreateObject("Scripting.FileSystemObject")
 
sCurPath = oFso.GetAbsolutePathName(".")
sSrcFile = sCurPath & "\Template.ott"
sNewFile = sCurPath & "\TextTest.odt"
 
Dim lOk, oField
 
Set oField = CreateObject("Scripting.Dictionary")
oField.add "cle1","valeur clé 1"
oField.add "cle2","valeur clé 2"
oField.add "cle3","valeur clé 3"
oField.add "cle4","valeur clé 4"
 
If ODFTemplate2File(sSrcFile,sNewFile,oField) then
	MsgBox("Ok")
Else
	MsgBox("Erreur")
End If
 
Set oField = Nothing
 
Function ODFTemplate2File(sOdfTemplate,sOdfFileName,oFieldTemplates)
	ODFTemplate2File = False
 
	Dim oODFso, sTempFolder, sTempFile, sOdfContent, oContent, sContent, aKey, cValue
 
	Set oODFso = CreateObject("Scripting.FileSystemObject")
	If oODFso.FileExists(sOdfTemplate) Then
		sTempFolder = GetFileName(Left(sOdfTemplate,Len(sOdfTemplate)-4))
		sTempFile = sTempFolder & ".zip"
		oODFso.CopyFile sOdfTemplate, sTempFile
		If UnZipFolder(sTempFile, sTempFolder) Then
			oODFso.DeleteFile sTempFile
			sOdfContent = sTempFolder & "\content.xml"
			If oODFso.FileExists(sOdfContent) Then
				Set oContent = oODFso.OpenTextFile(sOdfContent, ForReading)
				sContent = oContent.ReadAll
				oContent.Close
				oODFso.DeleteFile(sOdfContent)
				Set oContent = Nothing
				aKey = oFieldTemplates.keys
				For Each cValue In aKey
					sContent = Replace(sContent,"{" & cValue & "}",oFieldTemplates.item(cValue))
				Next
				Set oContent = oODFso.CreateTextFile(sOdfContent, true)
				oContent.Writeline(sContent)
				oContent.Close
				Set oContent = Nothing
			End If
			sOdfContent = sTempFolder & "\styles.xml"
			If oODFso.FileExists(sOdfContent) Then
				Set oContent = oODFso.OpenTextFile(sOdfContent, ForReading)
				sContent = oContent.ReadAll
				oContent.Close
				oODFso.DeleteFile(sOdfContent)
				Set oContent = Nothing
				aKey = oFieldTemplates.keys
				For Each cValue In aKey
					sContent = Replace(sContent,"{" & cValue & "}",oFieldTemplates.item(cValue))
				Next
				Set oContent = oODFso.CreateTextFile(sOdfContent, true)
				oContent.Writeline(sContent)
				oContent.Close
				Set oContent = Nothing
			End If
			ODFTemplate2File = ZipFolder(sTempFile, sTempFolder)
			oODFso.DeleteFolder(sTempFolder)
			oODFso.MoveFile sTempFile, sOdfFileName
		End If
	End If
	Set oODFso = Nothing
End Function
 
Function ZipFolder(sZipFile,sFolder)
	ZipFolder = True
 
	Dim oZipFso, oZip, oZipShell, oZipFolder
 
	Set oZipFso = CreateObject("Scripting.FileSystemObject")
	Set oZip = oZipFso.CreateTextFile(sZipFile)
	oZip.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
	oZip.Close
	WScript.Sleep 2000
	Set oZip = Nothing
	Set oZipShell = CreateObject("Shell.Application")
	Set oZipFolder = oZipShell.NameSpace(sFolder)
	If Not oZipFolder Is Nothing Then
		oZipShell.NameSpace(sZipFile).CopyHere oZipFolder.Items
		WScript.Sleep 2000
	Else
		ZipFolder = False
	End If
	Set oZipFolder = Nothing
	Set oZipShell = Nothing
	Set oZipFso = Nothing
End Function
 
Function UnZipFolder(sZipFile, sFolder)
	UnZipFolder = True
 
	Dim oUnZipFso, oUnZipShell, oUnZipFiles
 
	Set oUnZipFso = CreateObject("Scripting.FileSystemObject")
	If NOT oUnZipFso.FolderExists(sFolder) Then
		oUnZipFso.CreateFolder(sFolder)
	Else
		UnZipFolder = False
	End If
	Set oUnZipShell = CreateObject("Shell.Application")
	set oUnZipFiles = oUnZipShell.NameSpace(sZipFile).items
	oUnZipShell.NameSpace(sFolder).CopyHere(oUnZipFiles)
	WScript.Sleep 2000
	set oUnZipFiles = Nothing
	Set oUnZipShell = Nothing
	Set oUnZipFso = Nothing
End Function
 
Function GetFileName(sFile)
	GetFileName =  sFile & Year(Date) & Right("00" & Month(Date),2) & Right("00" & Day(Date),2) & Right("00" & Hour(Time),2) & Right("00" & Minute(Time),2) & Right("00" & Second(Time),2)
End Function