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 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
| Option Strict Off
Option Explicit On
'Déclaration des variables générales
'"""""""""""""""""""""""""""""""""""
Dim varfrom As String
Dim varbodyfile As String
Dim varsubject As String
Dim varto As String
Dim varattach As String
Dim nbfichier As Short
'Dim cl As Object
Dim nomfichier As String
Dim filespec As String
'UPGRADE_WARNING: La limite inférieure du tableau tabfichier est passée de 1 à 0. Cliquez ici : 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"'
Dim tabfichier(100) As String
'UPGRADE_WARNING: La limite inférieure du tableau tabfichiertv est passée de 1 à 0. Cliquez ici : 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"'
Dim tabfichiertv(100) As String
'UPGRADE_WARNING: La limite inférieure du tableau tabdoc est passée de 1 à 0. Cliquez ici : 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"'
Dim tabdoc(100) As String
Dim z, countdoc As Short
Dim chemin As String
Private Sub fichiernom()
'Déclaration des variables
'""""""""""""""""""""""""
Dim search As String
List1.Items.Clear() 'Vide la liste
search = Dir(chemin & "\intv\") 'Recherche des fichiers dans le dossier spécifié
If search <> "" Then
Do
List1.Items.Add(search)
search = Dir()
nbfichier = nbfichier + 1
Loop Until search = ""
End If
End Sub
Sub lirefichier()
'Déclaration des variables
'"""""""""""""""""""""""""
Dim contenu As String
Dim trouve As Boolean
Dim d As Short
Dim i As Short
Dim contenu2 As String
Dim nonvide As String
For i = 0 To nbfichier - 1
nomfichier = VB6.GetItemString(List1, i)
tabfichiertv(i + 1) = nomfichier FileOpen(1, (chemin & "\intv\" & nomfichier), OpenMode.Input)
Do While Not EOF(1)
nonvide = LineInput(1)
If Trim(nonvide) <> "" Then
contenu = (nonvide)
Else
contenu = ""
End If
List2.Items.Add(contenu)
Loop
FileClose(1)
varfrom = VB6.GetItemString(List2, 0)
varto = VB6.GetItemString(List2, 1)
varsubject = VB6.GetItemString(List2, 2)
varbodyfile = "C:\mail\indat\" & VB6.GetItemString(List2, 3)
'""""""""""""""""""""""""""""""""""""""""""""
If varfrom = "" Then 'test pour vérifier si le fichier n'est pas vide
DeleteAFile((chemin & "\intv\" & nomfichier))
GoTo Lsuivant
End If
Next
Call Clemail_Renamed()
'*************************************************
'
'
'
'Appel de la sub Shell qui envoiue le mail --- jusqu'ici tout va bien
'
'
'
'
'*************************************************
'Suppression du fichier INDAT
z = z + 1
filespec = chemin & "\indat\" & VB6.GetItemString(List2, 3)
tabfichier(z) = filespec
List2.Items.Clear()
Lsuivant:
Next
If nbfichier <> 0 Then
Me.Close() 'Décharge la feuille
Call Tempo() 'appel de la sub tempo ds module
Else
Me.Close() 'Décharge la feuille
End If
' fin de la procedure
End Sub
Sub suppression()
'declaration des variables necessaires à l'export en VB.NET
Dim f As Short
Dim t As Short
'On supprime ici les fichiers TV,TXT et les fichiers joints
For t = 0 To nbfichier - 1
'filespec = chemin & "\intv\" & List1.List(t - 1)
'DeleteAFile (filespec)
filespec = chemin & "\intv\" & tabfichiertv(t + 1)
Call DeleteAFile(filespec)
Next
For f = 0 To z - 1
Call DeleteAFile(tabfichier(f + 1))
Next
For f = 0 To countdoc - 1
Call DeleteAFile(tabdoc(f + 1))
Next
Me.Close()
End Sub
Sub DeleteAFile(ByRef filespec As String)
'Cette procédure permet de supprimer un fichier
'""""""""""""""""""""""""""""""""""""""""""""""
Dim fso As Object
fso = CreateObject("Scripting.FileSystemObject")
If FileExists(filespec) Then fso.DeleteFile(filespec)
End If
End Sub
Function FileExists(ByRef nom As String) As Boolean
'Cette fonction permet de savoir si le fichier existe dans le répertoire
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
FileExists = (Dir(nom) <> "")
End Function
Private Sub Clemail_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Dim fso, msg As Object
Dim rep3, rep1, rep2, rep4 As String
chemin = "C:\mail"
'UPGRADE_ISSUE: App propriété App.TaskVisible - Mise à niveau non effectuée Cliquez ici : 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2069"'
'App.TaskVisible = False 'Rend invisible l'application dans la barre des tâches
rep1 = chemin & "\intv\"
rep2 = chemin & "\indat\"
rep3 = chemin & "\doc\"
rep4 = chemin & "\obj\"
fso = CreateObject("Scripting.FileSystemObject")
nbfichier = 0 'Initialisation du nombre de fichiers à 0
z = 0
countdoc = 0
Call fichiernom() 'Appel de la sub fichiernom
Call lirefichier() 'Appel de la sub lirefichier
End Sub
Private Sub Clemail_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
Compteur.DefInstance.Close() 'quitte l'application
End Sub
End Class |
Partager