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
| 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
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
Repertoire = "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades\Essai\"
'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
Exit Sub
End Sub
Sub change_le_nom_des_xls()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim chemin As Variant
Dim filtre As Variant
Dim fichiers As Variant
Dim Workbook As Variant
Dim objFSO As Variant
chemin = ThisWorkbook.Path & "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades\Essai\" ' 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 <> "" '
Workbook.Open (chemin & fichiers)
'on sauve le classeur sous le nom
ActiveWorkbook.SaveAs Filename:=chemin & Range("C22") & "_" & Range("C20") & "_" & Range("B8") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'on va supprimer le fichier portant l'ancien nom
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (chemin & fichiers)
fichiers = Dir
Loop
End Sub |
