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
|
Public Sub Command1_Click()
Dim Truc As Integer
Dim Bidule As Integer
Dim Chouet As Integer
Dim FSO
Dim Path, PathLight, PathFSO
Dim middle As Integer
Dim oShell As Object, fso As Object
Dim i As Long
Dim Fichier As String, MyBinary As String
Dim LeZip As Variant
Dim MyHex As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
Path = "C:\test\" & Text1.Text
PathFSO = "C:\test\" & Text1.Text & "\" 'chemin du dossier
PathLight = "C:\test\"
Truc = FreeFile
Bidule = FreeFile + 1
Chouet = FreeFile + 2
middle = FreeFile + 3
If Dir(PathLight & "Truc.dat", vbHidden) <> "" Then FSO.DeleteFile (PathLight & "Truc.dat") ' suppression des fichiers si il existent deja
If Dir(PathLight & "Bidule.dat", vbHidden) <> "" Then FSO.DeleteFile (PathLight & "Bidule.dat")
If Dir(PathLight & "Chouet.dat", vbHidden) <> "" Then FSO.DeleteFile (PathLight & "Chouet.dat")
If Dir(PathFSO, vbHidden) <> "" Then
FSO.DeleteFolder (Path)
End If
Open "C:\test\Truc.dat" For Output As #Truc 'creation et remplissage du fichier Truc.txt
Print #Truc, Text1.Text & Text2.Text
Close #Truc
Open "C:\test\Bidule.dat" For Output As #Bidule 'creation et remplissage du fichier Bidule.txt
Print #Bidule, "00000001:" & Text4.Text & ";" & Text5.Text & "."
Close #Bidule
Open "C:\test\Chouet.dat" For Output As #Chouet 'creation et remplissage du fichier Chouet.txt
Print #Chouet, "00001:" & Combo1.Text & ":" & Text6.Text & " " & Text7.Text & ";"
Close #Chouet
FSO.CreateFolder (PathFSO) 'creation du dossier FSO
Open PathFSO & Text2.Text & ".txt" For Output As #middle 'creation et remplissage du fichier contenu dans FSO
Print #middle, Text3.Text & ";00000001;00001;;DATE_MADC:09.12.2011"
Close #middle
Fichier = PathFSO & Text2.Text & ".txt" 'fichier a zipper
LeZip = PathFSO & Text2.Text & ".zip" 'fichier zipper
Set fso = CreateObject("Scripting.FileSystemObject") 'zippage du fichier
MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
With fso.CreateTextFile(LeZip, True)
.Write MyBinary
.Close
End With
Set oShell = CreateObject("Shell.Application")
oShell.NameSpace(LeZip).CopyHere (Fichier)
Set oShell = Nothing
Tempo (1)
Kill PathFSO & "\" & Text2.Text & ".txt" 'destruction du fichier txt qui vient d'etre zipper
Tempo (1)
Name LeZip As PathFSO & "\" & Text2.Text & ".dat" 'renommage du fichier zip en .dat
End Sub |
Partager