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
| Option Explicit
'****************************************************************************************
'* Ce script est Modifié par Hackoo le 30/07/2013
'* Ajout de La Fonction BrowseForFile() pour parcourir le fichier CSV pour la Conversion
'****************************************************************************************
' Vbscript Original
'http://www.tech-archive.net/Archive/Scripting/microsoft.public.scripting.vbscript/2005-05/msg00794.html
'* This VBS (Visual Basic Script) program does the following:
'* Reads a CSV file, formats a HTML table, and writes a HTM file.
'*****************************************************************************************
'* Declare Constants
'*
Const cVBS = "csv2html.vbs"
Const cHTM = "csv2html.htm"
'*
'* Declare Variables
'*
Dim arrCSV,intCSV,strCSV,arrDAT,intDAT,strSFN,cCSV,strHTM
cCSV = BrowseForFile
Dim arrSTR()
ReDim arrSTR(100)
Dim intSTR
intSTR = 0
'*
'* Declare Objects
'*
Dim objFSO,ws
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Dim objOTF
'*
'* Read CSV Page
'*
Set objOTF = objFSO.OpenTextFile(cCSV,1)
strCSV = objOTF.ReadAll()
Set objOTF = Nothing
'*
'* Build table
'*
Append "<body text=white bgcolor=#1234568>"&_
"<table border='3' cellpadding='1' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%'>"
arrCSV = Split(strCSV,vbCrLf)
For intCSV = 0 To UBound(arrCSV)
arrDAT = Split(arrCSV(intCSV),",")
Append "</tr>"
For intDAT = 0 To UBound(arrDAT)
Append "<td><center>" & arrDAT(intDAT) & "</center></td>"
Next
Append "</tr>"
Next
Append "</table>"
'*
'* Write HTM File
'*
strHTM = Concat()
Set objOTF = objFSO.OpenTextFile(strSFN & cHTM,2,true)
objOTF.WriteLine(strHTM)
Set objOTF = Nothing
'*
'* Destroy Objects
'*
Set objFSO = Nothing
'*
'* Finish
'*
'MsgBox UBound(arrCSV)+1 & " Lignes dans le tableau",vbInformation,cVBS
Ws.Run cHTM
Sub Append(strSTR)
'****
'* Append()
'*
'* Appends strings to array entries ReDim as needed; (see "Concat()").
'****
strSTR = strSTR & ""
If intSTR > UBound(arrSTR) Then
ReDim Preserve arrSTR(UBound(arrSTR) + 100)
End If
arrSTR(intSTR) = strSTR & vbCrLf
intSTR = intSTR + 1
End Sub
Function Concat()
'****
'* Concat()
'*
'* Concatenates array entries into a single string; (see "Append()").
'****
Redim Preserve arrSTR(intSTR)
Concat = Replace(Join(arrSTR, ""),"`",Chr(34))
Erase arrSTR
ReDim arrSTR(100)
intSTR = 0
End Function
Function BrowseForFile()
With CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
Dim tempName : tempName = fso.GetTempName() & ".hta"
Dim path : path = "HKCU\Volatile Environment\MsgResp"
With tempFolder.CreateTextFile(tempName)
.Write "<input type=file name=f>" & _
"<script>f.click();(new ActiveXObject('WScript.Shell'))" & _
".RegWrite('HKCU\\Volatile Environment\\MsgResp', f.value);" & _
"close();</script>"
.Close
End With
.Run tempFolder & "\" & tempName,0,True
BrowseForFile = .RegRead(path)
.RegDelete path
End With
End Function |
