Bonjour,
Je reçois chaque semaine plusieurs fichiers CSV par mail que je voudrais stocker dans un répertoire pour faire un traitement de masse derrière.
J'ai trouvé le code d'un script pour faire cela, mais je n'arrive pas a le faire fonctionner. Il crée bien un dossier avec l'adresse mail de l'expéditeur du message, mais le dossier reste vide.
J'ai cherché sur les différents forums mais je reste coincé.
J'ai trouvé le code suivant en ligne (a cette adresse : http://outlook.developpez.com/faq/?p...eceive_Save_PJ) :
Merci d'avance pour votre aide.
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
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 Sub extrait_PJ_vers_rep(strID As Outlook.MailItem) ' ***olivier CATTEAU*** ' 23 avril 2007 Dim olNS As Outlook.namespace Dim MyMail As Outlook.MailItem Dim expediteur Set olNS = Application.GetNamespace("MAPI") Set MyMail = olNS.GetItemFromID(strID.EntryID) 'MsgBox "nouveau message" If MyMail.Attachments.Count > 0 Then expediteur = MyMail.SenderEmailAddress 'on crée le répertoire où mettre les fichiers joints ########################################################## 'c:\temp\pj\ doit déjà exister !!! Repertoire = "c:\temp\pj\" & expediteur & "\" If Repertoire <> "" Then If "" = Dir(Repertoire, vbDirectory) Then MkDir Repertoire End If End If 'on traite les pj Dim PJ, typeatt For Each PJ In MyMail.Attachments 'vérification si c'est une PJ Embedded typeatt = Isembedded(strID, PJ.Index) If typeatt = "" Then If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then MsgBox Repertoire & PJ.FileName & " existe !!" 'si existe copie vers le répertoire old If "" = Dir(Repertoire & "old", vbDirectory) Then MkDir Repertoire & "old" End If FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName End If PJ.SaveAsFile Repertoire & PJ.FileName End If Next PJ 'drapeau vert MyMail.FlagIcon = olGreenFlagIcon 'Marque lu MyMail.UnRead = False MyMail.Save 'on déplace le mail vers un sous dossier outlook Dim myDestFolder As Outlook.MAPIFolder Set myDestFolder = MyMail.Parent.Folders("test") MyMail.Move myDestFolder End If Set MyMail = Nothing Set olNS = Nothing Fin: End Sub ' Function: Fields_Selector ' Purpose: View type of attachment ' olivier catteau fevrier 2006 Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant Dim oSession As MAPI.Session ' CDO objects Dim oMsg As MAPI.Message Dim oAttachs As MAPI.Attachments Dim oAttach As MAPI.Attachment ' initialize CDO session On Error Resume Next Set oSession = CreateObject("MAPI.Session") oSession.Logon "", "", False, False ' get the message created earlier Set oMsg = oSession.GetMessage(strEntryID) ' set properties of the attached graphic that make ' it embedded and give it an ID for use in an image tag Set oAttachs = oMsg.Attachments Set oAttach = oAttachs.Item(attindex) Dim strCID As String strCID = oAttach.Fields(&H3712001E) Isembedded = strCID Set oMsg = Nothing oSession.Logoff Set oSession = Nothing End Function
Partager