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 |
