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
| Option Explicit
Const REPERTOIRE="V:\Excel"
Const XSL="\synthèse Excel en CSV.xsl"
Const RESULTCSV="\result.csv"
Const RESULTXML="\result.xml"
Const ForAppending=8, ForReading=1 , TristateTrue=-1
Dim fso,f,fd,txt,fluxDest,flux,fluxsource
Set fso = CreateObject("Scripting.FileSystemObject")
set fd=fso.GetFolder(REPERTOIRE)
Set fluxDest = CreateObject("ADODB.Stream")
with fluxDest
.Open
.Type = 2 'text
.Position = 0
.Charset = "utf-8"
.WriteText "<?xml version=""1.0"" encoding=""UTF-8""?><root>"
end with
set fluxsource=CreateObject("ADODB.Stream")
with fluxsource
.type = 2
.Charset = "utf-8"
end with
for each f in fd.files
If f.type="Fichier QRESULT" Then
with fluxsource
.open
.LoadFromFile f
fluxdest.writetext .readtext
.close
end with
End if
next
with fluxdest
.WriteText "</root>"
.SaveToFile REPERTOIRE & RESULTXML, 2
.Close
end with
dim sheet
Set sheet = CreateObject("Msxml2.FreeThreadedDOMDocument")
sheet.async = False
sheet.load REPERTOIRE & XSL
dim template
Set template = CreateObject("Msxml2.XSLTemplate")
template.stylesheet = sheet
dim proc
Set proc = template.createProcessor()
dim stream
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1
with proc
.input =REPERTOIRE & RESULTXML
.output = stream
.transform
end with
stream.SaveToFile REPERTOIRE & RESULTCSV, 2
stream.Close |
