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
| Sub Main()
Dim objexcel As Object
Dim i As Long, j As Long, dernierligne As Long, tempo As Long, colonne As Long
Dim fso, dossier, fichier
Dim ligne As String, chemin As String, letter As String
Set objexcel = CreateObject("Excel.Application")
objexcel.DisplayAlerts = False
objexcel.workbooks.Add
i = 1
chemin = "..\user"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(chemin)
currentuser = Environ("USERNAME")
For Each fichier In dossier.Files
dernierligne = objexcel.Range("A1").CurrentRegion.Rows.Count
Open fichier For Input As #1
While Not EOF(1)
Line Input #1, ligne
tabSplit = Split(ligne, ";")
Dim cmpt As Long
For cmpt = LBound(tabSplit) To UBound(tabSplit)
If tabSplit(cmpt) Like "??/??/*" Then
tabSplit(cmpt) = Format(CDate(tabSplit(cmpt)), "dd/mmm/yyyy")
End If
If UBound(tabSplit) = 1 Then
tempo = dernierligne
objexcel.Cells(dernierligne, cmpt + 1).formula = tabSplit(cmpt)
colonne = cmpt + 2
Else
'objexcel.Range(Chr(65 + colonne) & tempo).formula = tabSplit(cmpt)
objexcel.Cells(tempo, colonne).formula = tabSplit(cmpt)
colonne = colonne + 1
End If
Next cmpt
If UBound(tabSplit) = 1 Then
dernierligne = dernierligne + 1
End If
Wend
Close #1
Next
objexcel.workbooks(1).saveas "C:\Documents and Settings\" & currentuser & "\Desktop\ess.xls"
objexcel.Quit
Set objexcel = Nothing
Set fso = Nothing
Set dossier = Nothing
End Sub |
[vbs] rassembler des fichiers txt en fichiers Xls
Répondre avec citation
Partager