Discussion :

[Naoned005]

Bonjour

J'ai crée un code qui va chercher tout les mail d'une regle et qui en extrait les piece jointe dans un dossier. Voila le code (il fonctionne parfaitement ).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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

Mais j'aimerais bien qu'il ouvre d'abord toute les pieces jointes et qu'il enregistre dans le chemin uniquement si en celllule C10, il y a la date de la veille.

Pour cela j'ai crée un fonction veille (et qui prend vendredi si lundi est la veille...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
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

Je pense qu'il faudrait intercaller à partir de là

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each att In mItem.Attachments

du code pour ouvrir les PJ et de les enregistrer si Range("C10").value = Veille mais je ne vois pas comment faire ça exactement.


Quelq'un pourrait me donner un coup de main?

[Daniel.C]

Bonjour,

Si j'ai bien compris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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
If [C10] = Veille Then
    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
End If
 
 
 
    Exit Sub
 
    End Sub

[Naoned005]

Bonjour

D abord merci pour la réponse

Si seulement c t aussi simple.! Enfin ça a l'air de fonctionner mais dans mon dossier Essai je n'ai plus rien avec ce code. Il ne semble pas prendre les fichier qui en C16 on la date de la veille!

Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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
 
 
If [C16] = Veille Then
 
    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
End If
 
 
 
    Exit Sub
 
    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

Et pourtant dans certains fichiers en C16 j'ai une date du type 03/05/2012????

Je me demandais si ce code ouvre les PJ pke finalement si il les ouvre pas c'est normal qu'il ne peut les lire??

Have a good day

[Daniel.C]

Bonjour,

Tu veux dire qu'il faut tester C10 (ou C16 ?) dans les fichiers joints ? sur quelle feuille ? est-ce que tous les fichiers joints sont des classeurs ?

[Naoned005]

Bonjour Daniel

C16 oui je m'était trompé la premiere fois. Toute les PJ sont des classeurs excel contenant 1 seul woorsheet!

Il manque qq chose mais je ne vois pas quoi. C'est pas une ouverture du classeur?

Merci

Oui C16 dans les fichier joint! C'est pour cela que je parle d'ouverture de la PJ.

Et cette PJ contient une feuille excel seulement, nommée GOBICS!! Et au risque de me repeter j'aimerais enregistrer dans le disque dur seulement les GOBICS ou le C 16 contient la date de la veille!

[Daniel.C]

Pas la peine de s'énerver. Tu n'as jamais précisé qu'il n'y avait que des classeurs en PJ, et que ceux-ci n'avaient qu'une feuille. Ceci dit, je bute sur une difficulté. Le dossier de stockage temporaire n'est à ma connaissance disponible que par la méthode "GetTemporaryFilePath" qui ne peut, à ce que j'ai compris, être utilisée que dans une macro évènementielle OutLook. Il reste la solution d'ouvrir tous les classeurs après les avoir sauvegardés, quitte à les supprimer ensuite. Si tu es d'accord, je poursuis dans cette direction.

[Naoned005]

Non tkt je m'enerve pas du tout! Ou alors contre moi même seulement pke j'arrive pas cette macro et tu as complétement raison j'ai mal expliqué mon truc.

Yes j'avais pensé a ça aussi! Il y deux solutions soit ouvrir les PJ avant qu'elles s'enregistrent et enregistrer celles qui ont la date de la veille en C16 dans le disque dur. Soit tous les enregistrer (ce qui est déjà le cas de ma macro) puis de les ouvrir tous et supprimer ceux qui ont pas la date de la veille en C16.

J'ai déjà si tu veux une macro qui ouvre tous les fichier enregistrer pour en tiré des informations et renommer les fichiers. Je pense qu'on pourrais travaillé dans ce code. Tu en pense quoi? ça serait peut etre mieux que dans le précedents? A partir de Workbooks.Open (chemin & fichiers)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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 = "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 <> "" '
 
    Workbooks.Open (chemin & fichiers)
 
    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:=chemin & 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 Sub