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
|
Option Explicit
Dim f, fsot, ft, ts
Dim fichierFEC, fso, fileObj, sIniDir, sFilter, sTitle, oDlg
Dim ln, cl
Dim strFile
Const ForReading = 1, ForAppending = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Function GetFileDlgEx(sIniDir,sFilter,sTitle)
Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
sIniDir = "C:\Users\Monique\Documents\FEC1\Testscript"
sFilter = "All files (*.*)|"
sTitle = "Selectionner un fichier"
fichierFEC = GetFileDlgEX(Replace(sIniDir,"\","\\"),sFilter,sTitle)
Set oFl = fso.OpenTextFile(fichierFEC) 'Message d'erreur ici
ln=-1
cl=0
Set ts = oFl.OpenAsTextStream
while Not ts.AtEndOfStream
ln=ln+1
Tab=Split(ts.ReadLine, Chr(9))
If cl < UBound(Tab) Then cl = UBound(Tab)
Wend
fichierFEC.Close
Dim Tab2()
ReDim Tab2(ln,cl)
i=0
while Not fichierFEC.AtEndOfStream
Tab=Split(fichierFEC.ReadLine, Chr(9))
For j = 0 to UBound(Tab)
Tab2(i,j) = Tab(j)
Next
i=i+1
Wend
ReDim Preserve Tab2(ln, cl+3)
For i=0 to UBound(Tab2, 1)
if Tab2(i,7) <> "" Then
Tab2(i,cl+1)= Tab2(i, 7)
else
Tab2(i,cl+1)= Tab2(i, 5)
end if
Next
Tab2(0, cl+2)= "Debit"
Tab2(0, cl+3)= "Credit"
For i=1 to UBound(Tab2, 1)
if Tab2(i, 12)= "D" Then
Tab2(i, cl+2)= Tab2(i, 11)
Tab2(i, cl+3)= 0
elseif Tab2(i, 12)= "C" Then
Tab2(i, cl+3)= Tab2(i, 11)
Tab2(i, cl+2)= 0
elseif Tab2(i, 12)= "-1" Then
Tab2(i, cl+2)= Tab2(i, 11)
Tab2(i, cl+3)= 0
elseif Tab2(i, 12)= "1" Then
Tab2(i, cl+3)= Tab2(i, 11)
Tab2(i, cl+2)= 0
else
Tab2(i, cl+2)= Tab2(i, 11)
Tab2(i, cl+3)= Tab2(i, 12)
end if
Next
f.Close
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\Users\Monique\Documents\FEC1\Testscript\FECModifie2.txt", 2,true)
m=0
For i=0 to UBound(Tab2,1)
For j=0 to UBound(Tab2,2)
If m < UBound(Tab2,2) Then
ft.write(Tab2(i,j) & " ")
m=m+1
else
ft.write(Tab2(i,j) & vbcrlf)
m=0
end if
Next
Next
ft.close
Msgbox ("Conversion terminee") |
Partager