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
| Dim objoutlook As Outlook.Application
Dim olns As Outlook.Namespace
Dim mItem As Outlook.MailItem
Dim att As Outlook.Attachment
Dim fld As Outlook.MAPIFolder
Dim Compteur As Integer
Dim message, Repertoire, NomDeFichierSurDisque, NomDeFichier, Taille, Emetteur As String
Dim AncienNom As String, NouveauNom As String
Dim chemin As Variant
Dim filtre As Variant
Dim fichiers As Variant
Dim Workbook As Variant
Dim objFSO As Variant
Dim Rep As String, RepMois As String, RepJour As String
Dim MaDate As Date
Option Explicit
Public Sub TransfertPJ()
'Création de l'objet Outlook
Set objoutlook = CreateObject("Outlook.application")
'Récupération de l'espace de nom d'outlook
Set olns = objoutlook.GetNamespace("MAPI")
'Récupération du répertoire "boite de réception" par défault
Set fld = olns.GetDefaultFolder(olFolderInbox)
' Initialisation du reperetoire de sauvegarde
' ne pas oublier l'anti-slash à la fin du repertoire
Rep = "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades"
'Si le répertoir père existe
If Dir(Rep, vbDirectory) <> "" Then
'Dans maDate on récuppère la date de la veille (si c'est un dimanche ou lundi, on prend vendredi précédent
'Ici appel à la fonction veille
MaDate = Veille
'On va chercher si le sous répertoire du mois existe au sein du répertoire père, on le crée s'il n'existe pas
RepMois = Rep & "\" & Format(MaDate, "mmmm yyyy")
If Dir(RepMois, vbDirectory) = "" Then MkDir RepMois
'On va chercher si le sous répertoire du jour existe au sein du sous répertoire du mois, on le crée s'il n'existe pas
RepJour = RepMois & "\" & Format(MaDate, "yyyymmdd")
If Dir(RepJour, vbDirectory) = "" Then MkDir RepJour
'Inialisation des variables Message, NomDeFichier, NomDeFichierSurDisque, Taille, Emetteur
message = NomDeFichierSurDisque = NomDeFichier = Taille = Emetteur = ""
' Sauve les pieces jointes des mails se trouvant dans la boîte de réception.
' Pour adresser un dossier dans la boite de réception on pourrait utiliser :
' fld.Folders("Nom_Du_Dossier").Items
For Each mItem In fld.Folders("Confirmation Oddo").Items
For Each att In mItem.Attachments
If att.Type = olByValue Then
' Nom du fichier modifié pour l'enregistrement. Evite les controles superflus en renommant.
NomDeFichier = att.Filename
NomDeFichierSurDisque = NomDeFichier
att.SaveAsFile Repertoire & NomDeFichierSurDisque
End If
Next
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = Rep ' chemin a adapter
'on va lister tout les fichiers de type excel en filtrant l'extention
filtre = "*.xls" ' ou le filtre que tu veux ... par exemple "*.txt" ou même "toto*.*"
fichiers = Dir(chemin & filtre, vbNormal Or vbHidden) 'on prend meme ce qui sont caché
'c'est parti
Do While fichiers <> "" '
Workbooks.Open (chemin & fichiers)
'LA JE RAJOUTE MA SUPPRESSION SI C16<>VEILLE
If Range("C16") <> Veille Then
Workbooks(chemin & fichiers).Close 'Je ferme le fichier pour pouvoir le supprimer
'Et je le suprimme
Set objFSOA = CreateObject("Scripting.FileSystemObject")
objFSOA.DeleteFile (chemin & fichiers)
End If
If Range("B13") = "" Then
'Macro pour la date et le sens de l'odre
Range("E15") = "=YEAR(R[-8]C[-3])"
Range("F15") = "=MONTH(R[-8]C[-4])"
Range("G15") = "=DAY(R[-8]C[-5])"
Range("D25") = "=R[-10]C[1]&R[-10]C[2]&R[-10]C[3]"
If Range("C20") = "Vente" Then Range("C20").Value = "SELL"
If Range("C20") = "Achat" Then Range("C20").Value = "BUY"
'on sauve le classeur sous le nom
ActiveWorkbook.SaveAs Filename:=chemin & Range("C22") & "_" & Range("C20") & "_" & Range("B8") & "_" & Range("D25") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
'on va supprimer le fichier portant l'ancien nom
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (chemin & fichiers)
fichiers = Dir
End If
If Range("B13") = "OPERATION N°" Then
'Macro pour la date et le sens de l'ordre
Range("E15") = "=YEAR(R[-7]C[-3])"
Range("F15") = "=MONTH(R[-7]C[-4])"
Range("G15") = "=DAY(R[-7]C[-5])"
Range("D25") = "=R[-10]C[1]&R[-10]C[2]&R[-10]C[3]"
If Range("C20") = "Vente" Then Range("C20").Value = "SELL"
If Range("C20") = "Achat" Then Range("C20").Value = "BUY"
'on sauve le classeur sous le nom
ActiveWorkbook.SaveAs Filename:=RepJour & "\" & Range("C22") & "_" & Range("C20") & "_" & Range("B9") & "_" & Range("D25") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
'on va supprimer le fichier portant l'ancien nom
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (chemin & fichiers)
fichiers = Dir
End If
Loop
End If
End Sub
Private Function Veille() As Date
Dim d As Byte
d = DatePart("w", Date, vbSunday) 'Si Date est Dimanche ou Lundi, on prend Vendredi comme étant la veille. 'Sinon, on prend j-1
Veille = Date - IIf(d <= 2, d + 1, 1)
End Function |
re
comme les autre méthodes
: ça peut servir aux autres 
Répondre avec citation
)
. ça a pas l'air logique comme ça parce que les fichiers enregistré auparavant seront supprimé.
Partager