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 |
Partager