Discussion :

[Oliv-]

ok donc tu n'as pas besoin de réouvrir les fichiers MSG pour ton export de PJ ! Donc ta macro que j'ai corrigé RetrieveMailFiles_Click dois fonctionner

[Oliv-]

si tu veux à la suite de ton script de l'étape 1 extraire la pj excel ou csv

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
Sub Script_Export_XLS(Item AS MAILITEM)
 
    Dim MonOutlook As Outlook.Application
    Dim ns As Namespace
    Dim Inbox As MAPIFolder
    Dim Atmt As Attachment
    Dim FileName As String
    Dim Mypath As String
    Dim i As Integer
    Dim dtDate As Date
    Dim sDate As String
    Dim sName2 As String
    Dim sName3 As String
    Dim Inbox2 As MAPIFolder
    Dim Inbox3 As MAPIFolder
    Dim Td As Date
    Dim Rd As Date
    Dim Nd As String
    Dim awb As Workbook
    Dim aws As Worksheet
    Set ns = GetNamespace("MAPI")
 
 
 
    Set awb = ThisWorkbook
    Set aws = awb.ActiveSheet
    Dim d As String
 
    Application.ScreenUpdating = False
 
 
            '-----------------------------------------------------------------------------------------------------------------------/ MULTINVEST /----------------------------------------
 
            If Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" Then
 
                'Création d'un fichier temporaire "datefile" correspondant à la pièce jointe
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\datefile.xls"
                Atmt.SaveAsFile FileName
                Workbooks.Open FileName
                'Copie de la cellule "A2" correspondant à la date de NAV
                Range("A2").Copy aws.Range("B2")
                'Collage du contenu de "A2" dans la cellule "B2" du fichier "Extraction - Browser.xlsm"
 
                'Ouverture du fichier temporaire "datefile" correspondant à la pièce jointe
                Workbooks.Open FileName
                'Copie de la cellule "E2" correspondant au nom du fond
                Range("E2").Copy aws.Range("B3")
                'Collage du contenu de "E2" dans la cellule "B3" du fichier "Extraction - Browser.xlsm"
 
                'Fermeture du fichier temporaire "datefile..xls"
                Workbooks("datefile.xls").Close
                Kill FileName
 
                'Création du fichier final
                Windows("Extraction - Browser.xlsm").Activate
                ActiveWorkbook.Save
                sDate = aws.Range("D2").Value          '(2015.10.20)
 
                If Item.Body Like "*Multinvest*" Then
 
                    sName2 = aws.Range("D3").Value      '(BSI-Multinvest - Asian/Bond)
                    sName3 = aws.Range("B4").Value      '(Classic Price)
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " - " & sName3 & ".xls"
 
                    '--------------------------------------------------/ MULTI CHALLENGE SICAV - Centurion /----------------------------------------
                ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Centurion*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Centurion" & " - " & sName3 & ".xls"
 
                    '---------------------------------------------------/ MULTI CHALLENGE SICAV - Globes /----------------------------------------
                ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Globes*" Then
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Globes Portfolio" & " - " & sName3 & ".xls"
 
 
                    '----------------------------------------------------/ MULTI CHALLENGE SICAV - Global Inflation Shield /----------------------------------------
                ElseIf Item.Body Like "*Multi Challenge Sicav - Global*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Global Inflation Shield" & " - " & sName3 & ".xls"
 
 
                    '-----------------------------------------------------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Global Inflation Shield /----------------------------------------
                ElseIf Item.Body Like "*Multi Challenge Sicav - Global*" Then
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Global Inflation Shield" & " - " & sName3 & ".xls"
                    '-----------------------------------------------------------------------------------------------------------------------/ HEREFORD /----------------------------------------
 
                ElseIf Item.Body Like "*Hereford Funds*" Then
                    sName2 = aws.Range("D3").Value      '(BSI-Multinvest - Asian/Bond)
                    sName3 = aws.Range("B4").Value      '(Classic Price)
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " " & sName3 & ".xls"
 
 
                    '-----------------------------------------------------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Digamma /----------------------------------------
                ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Digamma*" Then
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Digamma" & " - " & sName3 & ".xls"
 
                End If
 
                Atmt.SaveAsFile FileName
 
                Item.UnRead = False
 
 
 
 
            End If
 
            'Attachment suivant au sein du meme mail
 
 
End Sub

[8Telegraphist8]

Ok merci, on tient le bon bout.

Par contre dans ma régle je ne peux exécuter qu'un script. C'est le script "Project1.GlobesCP" qui s'execute en appelant la fonction "SavMsgFundType".

Je dois donc ajouter un "Call" au code VBA suivant :

Code :

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

1
2
3
4
 
Sub rule_GlobesCP(Mail As Outlook.MailItem)
    FundType = "MC - Globes"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)

la ligne :

Code :

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

1
2
 
    Call Script_Export_XLS(Item)

de manière à exécuter d'abord la sauvegarde du mail

puis

l'extraction

C'est ça ?

Fred

[Oliv-]

oui

Code :

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

  Call Script_Export_XLS(Mail )

[8Telegraphist8]

Il doit manquer un petit truc
La sauvegarde du .msg fonctionne bien mais pas d'extraction

Je n'ai testé qu'avec un "globesCP" voilà pourquoi il n'y a que la ligne du script "globes" qui comporte deux "Call"


Voici le 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
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
 
 
'-------------------------------------------------Les scripts devant être associés aux règles Outlook----------------------------
 
'----------------------Règle 1-------------------------------------------------------------------------------------------------------
Sub rule_Digamma(Mail As Outlook.MailItem)
    FundType = "MC - Digamma"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\MC - Digamma\", FundType)
 
End Sub
'----------------------Règle 11-------------------------------------------------------------------------------------------------------
Sub rule_DigammaPD(Mail As Outlook.MailItem)
    FundType = "MC - Digamma"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\02.Portfolio Details\", FundType)
 
End Sub
'----------------------Règle 111-------------------------------------------------------------------------------------------------------
Sub rule_DigammaCP(Mail As Outlook.MailItem)
    FundType = "MC - Digamma"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)
 
End Sub
'----------------------Règle 2-------------------------------------------------------------------------------------------------------
Sub rule_Globes(Mail As Outlook.MailItem)
    FundType = "MC - Globes"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\MC - Globes\", FundType)
 
End Sub
'----------------------Règle 22-------------------------------------------------------------------------------------------------------
Sub rule_GlobesPD(Mail As Outlook.MailItem)
    FundType = "MC - Globes"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\02.Portfolio Details\", FundType)
 
End Sub
'----------------------Règle 222-------------------------------------------------------------------------------------------------------
Sub rule_GlobesCP(Mail As Outlook.MailItem)
    FundType = "MC - Globes"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)
    Call Script_Export_XLS(Mail)
 
End Sub
'----------------------Règle 3-------------------------------------------------------------------------------------------------------
Sub rule_Centurion(Mail As Outlook.MailItem)
    FundType = "MC - Centurion"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\MC - Centurion\", FundType)
 
End Sub
'----------------------Règle 33-------------------------------------------------------------------------------------------------------
Sub rule_CenturionPD(Mail As Outlook.MailItem)
    FundType = "MC - Centurion"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\02.Portfolio Details\", FundType)
 
End Sub
'----------------------Règle 333-------------------------------------------------------------------------------------------------------
Sub rule_CenturionCP(Mail As Outlook.MailItem)
    FundType = "MC - Centurion"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)
 
End Sub
'----------------------Règle 4-------------------------------------------------------------------------------------------------------
Sub rule_MI(Mail As Outlook.MailItem)
    FundType = "MI"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\MI\", FundType)
 
End Sub
'----------------------Règle 44-------------------------------------------------------------------------------------------------------
Sub rule_MIPD(Mail As Outlook.MailItem)
    FundType = "MI"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\02.Portfolio Details\", FundType)
 
End Sub
'----------------------Règle 444-------------------------------------------------------------------------------------------------------
Sub rule_MICP(Mail As Outlook.MailItem)
    FundType = "MI"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)
 
End Sub
'----------------------Règle 5-------------------------------------------------------------------------------------------------------
Sub rule_AlterUCITS(Mail As Outlook.MailItem)
    FundType = "MI - AlterUCITS"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\MI - Alternative UCITS\", FundType)
 
End Sub
'----------------------Règle 55-------------------------------------------------------------------------------------------------------
Sub rule_AlterUCITsPD(Mail As Outlook.MailItem)
    FundType = "MI - AlterUCITS"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\02.Portfolio Details\", FundType)
 
End Sub
'----------------------Règle 555-------------------------------------------------------------------------------------------------------
Sub rule_AlterUCITsCP(Mail As Outlook.MailItem)
    FundType = "MI - AlterUCITS"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)
 
End Sub
'----------------------Règle 6-------------------------------------------------------------------------------------------------------
Sub rule_HF(Mail As Outlook.MailItem)
    FundType = "Hereford Funds"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\HF\", FundType)
 
End Sub
'----------------------Règle 66-------------------------------------------------------------------------------------------------------
Sub rule_HFPD(Mail As Outlook.MailItem)
    FundType = "Hereford Funds"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\02.Portfolio Details\", FundType)
 
End Sub
'----------------------Règle 667-------------------------------------------------------------------------------------------------------
Sub rule_HFCP(Mail As Outlook.MailItem)
    FundType = "Hereford Funds"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\01.Classic Price\", FundType)
 
End Sub
'----------------------Règle 7-------------------------------------------------------------------------------------------------------
Sub rule_CumulR(Mail As Outlook.MailItem)
    FundType = "Cumulated Report"
    Call SavMsgFundType(Mail, "H:\BSI ManCo\Control Function\99. DWH\Incoming Mails\Cumulated Reports\", FundType)
 
End Sub
 
'-------------------------------------------------La macro étant appelée par les scripts--------------------------------------------
 
'----------------------Macro---------------------------------------------------------------------------------------------------------
 
Sub SavMsgFundType(MyMail As Outlook.MailItem, repertoire, FundType)
 
'Construction du nom de fichier sauvegardé
    dtDate = MyMail.ReceivedTime
    mlSubj = MyMail.Subject
    NomExport = Format(dtDate, "yyyy.mm.dd", vbUseSystemDayOfWeek, vbUseSystem) & " - " & Format(dtDate, "hh.nn.ss", vbUseSystemDayOfWeek, vbUseSystem) & " - " & FundType & " - " & mlSubj
 
    'Ici on vérifie le répertoire où l'enregistrer
    If Right(repertoire, 1) <> "\" Then repertoire = repertoire & "\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", "."), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
 
    While Dir(PathNomExport) <> ""
 
        'MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        n = n + 1
    Wend
 
    MyMail.SaveAs PathNomExport, OlSaveAsType.olMsg
 
End Sub
 
Sub Script_Export_XLS(Item As MailItem)
 
    Dim MonOutlook As Outlook.Application
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Atmt As Attachment
    Dim FileName As String
    Dim Mypath As String
    Dim i As Integer
    Dim dtDate As Date
    Dim sDate As String
    Dim sName2 As String
    Dim sName3 As String
    Dim Inbox2 As MAPIFolder
    Dim Inbox3 As MAPIFolder
    Dim Td As Date
    Dim Rd As Date
    Dim Nd As String
    Dim awb As Workbook
    Dim aws As Worksheet
    Set ns = GetNamespace("MAPI")
 
 
    Set awb = ThisWorkbook
    Set aws = awb.ActiveSheet
    Dim d As String
 
    Application.ScreenUpdating = False
 
 
            If Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" Then
 
                'Création d'un fichier temporaire "datefile" correspondant à la pièce jointe
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\datefile.xls"
                Atmt.SaveAsFile FileName
                Workbooks.Open FileName
                'Copie de la cellule "A2" correspondant à la date de NAV
                Range("A2").Copy aws.Range("B2")
                'Collage du contenu de "A2" dans la cellule "B2" du fichier "Extraction - Browser.xlsm"
 
                'Ouverture du fichier temporaire "datefile" correspondant à la pièce jointe
                Workbooks.Open FileName
                'Copie de la cellule "E2" correspondant au nom du fond
                Range("E2").Copy aws.Range("B3")
                'Collage du contenu de "E2" dans la cellule "B3" du fichier "Extraction - Browser.xlsm"
 
                'Fermeture du fichier temporaire "datefile..xls"
                Workbooks("datefile.xls").Close
                Kill FileName
 
                'Création du fichier final
                Windows("Extraction - Browser.xlsm").Activate
                ActiveWorkbook.Save
                sDate = aws.Range("D2").Value          '(2015.10.20)
 
'----------------------------------------------------------------------------/ MULTINVEST /----------------------------------------
                If Item.Body Like "*Multinvest*" Then
 
                    sName2 = aws.Range("D3").Value      '(BSI-Multinvest - Asian/Bond)
                    sName3 = aws.Range("B4").Value      '(Classic Price)
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " - " & sName3 & ".xls"
 
 '----------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Centurion /---------------
                ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Centurion*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Centurion" & " - " & sName3 & ".xls"
 
'---------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Globes /--------------------
                ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Globes*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Globes Portfolio" & " - " & sName3 & ".xls"
 
'--------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Global Inflation Shield /------
                ElseIf Item.Body Like "*Multi Challenge Sicav - Global*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Global Inflation Shield" & " - " & sName3 & ".xls"
 
'--------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Global Inflation Shield /-------
                ElseIf Item.Body Like "*Multi Challenge Sicav - Global*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Global Inflation Shield" & " - " & sName3 & ".xls"
'--------------------------------------------------------------------------/ HEREFORD /------------------------------------------------
                ElseIf Item.Body Like "*Hereford Funds*" Then
 
                    sName2 = aws.Range("D3").Value      '(BSI-Multinvest - Asian/Bond)
                    sName3 = aws.Range("B4").Value      '(Classic Price)
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " " & sName3 & ".xls"
 
'--------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Digamma /--------------------
                ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Digamma*" Then
 
                    'sName2 = "BSI Multinvest SICAV"
                    sName3 = aws.Range("B4").Value
 
                    FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Digamma" & " - " & sName3 & ".xls"
 
                End If
 
                Atmt.SaveAsFile FileName
 
                Item.UnRead = False
 
            End If
 
            'Attachment suivant au sein du meme mail
 
End Sub

Est-ce qu'il ne faudrait pas juste avant le

Code :

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

1
2
 
If Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" Then

Ouvrir simplement le fichier "Extraction - Browser". Je dis cela car lorsque je fais habituellement l'extraction sans automatiser par Outlook, le fichier est ouvert.

Merci à toi

Fred

[8Telegraphist8]

Parce qu'en fait quand tu dis :

Code :

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

1
2
3
 
Set awb = ThisWorkbook
Set aws = awb.ActiveSheet

il n'y a pas de Workbook actif mais simplement Outlook qui est ouvert.

[Oliv-]

qu"y a t'il dans tes formules ?



que désigne awb ? ="Extraction - Browser.xlsm" ?

Tu ne as pas répondu à mes questions ci dessus
Oui il faut lancer Excel mais ça quoi sert vraiment extraction browser ? Mis à part qu il contient les macros

[8Telegraphist8]

Hello Oliv

Pour que tu comprennes mieux. Voici ma macro en pièce jointe. Ca sera beaucoup plus pratique

Je t'envoie le mot de passe en MP

Fred

[8Telegraphist8]

En gros pour faire simple, je souhaiterais que ces deux macros, présentent dans le fichier Excel en pièce jointe s'exécutent à l'arrivée d'un mail, en même temps que les scripts de sauvegarde enregistrent le .msg sur le réseau.

Tu vois le truc ?

[Oliv-]

salut,

En fait la copie vers la feuille de "Extraction - Browser.xlsm", et les formules peuvent être remplacées par du vba.

Dès que j'ai un peu de temps je te corrige cela.

[8Telegraphist8]

Oui très certainement.
A l'époque je cherchais surtout un moyen rapide. Du coup c'est vrai qu'on est un peu loin du code pur.

Mais si tu as un moment, sans te prendre trop la tête, c'est avec plaisir, ca m'aidera beaucoup.

Merci

Fred

[8Telegraphist8]

Hello Oliv.

Tu as eu un peu de temps pour jeter un œil à la modif ? Ca me parait quand même compliqué de se dispenser du fichier Excel de renommage non ?

Fred

[Oliv-]

SAlut,
voici qui devrait faire l'affaire
à mettre dans OUTLOOK , il faut ajouter une référence à MICROSOFT EXCEL XX.0 object library

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
142
Option Explicit
Sub test_Script_Export_XLS()
    Script_Export_XLS ActiveInspector.CurrentItem
End Sub
Sub Script_Export_XLS(Item As MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim TmpFileName As String
    Dim sDate As String
    Dim sName2 As String
    Dim sName3 As String
    Dim wk As Workbook
    Dim ws As Worksheet
    Dim oExcel As excel.Application
    Dim RangeB2
    Dim RangeB3
 
 
    Set oExcel = CreateObject("excel.application")
    oExcel.Visible = True
 
    Dim d As String
 
    For Each Atmt In Item.Attachments
        '-----------------------------------------------------------------------------------------------------------------------/ MULTINVEST /----------------------------------------
 
        If Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" Then
 
            'Création d'un fichier temporaire "datefile" correspondant à la pièce jointe
            TmpFileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\datefile.xls"
            Atmt.SaveAsFile TmpFileName
            Set wk = oExcel.Workbooks.Open(TmpFileName)
            Set ws = wk.ActiveSheet
            'Copie de la cellule "A2" correspondant à la date de NAV
            RangeB2 = ws.Range("A2").Value
 
            'Range("A2").Copy aws.Range("B2")
            'Collage du contenu de "A2" dans la cellule "B2" du fichier "Extraction - Browser.xlsm"
 
            'Copie de la cellule "E2" correspondant au nom du fond
            RangeB3 = ws.Range("E2").Value
            'Range("E2").Copy aws.Range("B3")
            'Collage du contenu de "E2" dans la cellule "B3" du fichier "Extraction - Browser.xlsm"
 
            'Création du fichier final
            '        Windows("Extraction - Browser.xlsm").Activate
            '        ActiveWorkbook.Save
            'sDate = aws.Range("D2").Value          '(2015.10.20)
            sDate = Format(RangeB2, "yyyy.mm.dd")       '(2015.10.20)
            sName2 = Left(RangeB3, InStr(1, RangeB3, " ", vbTextCompare) + 7)    '(BSI-Multinvest - Asian/Bond)
 
            If Item.Body Like "*Multinvest*" Then
                '
                '            sName2 = aws.Range("D3").Value      '(BSI-Multinvest - Asian/Bond)
                '            sName3 = aws.Range("B4").Value      '(Classic Price)
                sName3 = "Classic Price"
 
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " - " & sName3 & ".xls"
 
                '--------------------------------------------------/ MULTI CHALLENGE SICAV - Centurion /----------------------------------------
            ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Centurion*" Then
 
                'sName2 = "BSI Multinvest SICAV"
                'sName3 = aws.Range("B4").Value
                sName3 = "Classic Price"
 
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Centurion" & " - " & sName3 & ".xls"
 
                '---------------------------------------------------/ MULTI CHALLENGE SICAV - Globes /----------------------------------------
            ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Globes*" Then
                'sName2 = "BSI Multinvest SICAV"
                'sName3 = aws.Range("B4").Value
                sName3 = "Classic Price"
 
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Globes Portfolio" & " - " & sName3 & ".xls"
 
 
                '----------------------------------------------------/ MULTI CHALLENGE SICAV - Global Inflation Shield /----------------------------------------
            ElseIf Item.Body Like "*Multi Challenge Sicav - Global*" Then
 
                'sName2 = "BSI Multinvest SICAV"
                'sName3 = aws.Range("B4").Value
                sName3 = "Classic Price"
 
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Global Inflation Shield" & " - " & sName3 & ".xls"
 
 
                '-----------------------------------------------------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Global Inflation Shield /----------------------------------------
            ElseIf Item.Body Like "*Multi Challenge Sicav - Global*" Then
                'sName2 = "BSI Multinvest SICAV"
                'sName3 = aws.Range("B4").Value
                sName3 = "Classic Price"
 
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Global Inflation Shield" & " - " & sName3 & ".xls"
                '-----------------------------------------------------------------------------------------------------------------------/ HEREFORD /----------------------------------------
 
            ElseIf Item.Body Like "*Hereford Funds*" Then
                'sName2 = aws.Range("D3").Value      '(BSI-Multinvest - Asian/Bond)
                'sName3 = aws.Range("B4").Value      '(Classic Price)
                sName3 = "Classic Price"
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " " & sName3 & ".xls"
 
 
                '-----------------------------------------------------------------------------------------------------------------------/ MULTI CHALLENGE SICAV - Digamma /----------------------------------------
            ElseIf Item.Body Like "*MULTI CHALLENGE SICAV - Digamma*" Then
                'sName2 = "BSI Multinvest SICAV"
                'sName3 = aws.Range("B4").Value
                sName3 = "Classic Price"
 
                FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\" & sDate & " - " & "MULTI CHALLENGE SICAV - Digamma" & " - " & sName3 & ".xls"
 
            End If
            Dim fso, F, sExt, Fullpath, sNom
            Set fso = CreateObject("Scripting.FileSystemObject")
            F = fso.GetBaseName(FileName)
            sExt = fso.GetExtensionName(FileName)
            Fullpath = fso.GetParentFolderName(FileName)
 
            ' oExcel.DisplayAlerts = False
            ws.Columns("A:AE").Columns.AutoFit
            wk.SaveAs FileName:=Fullpath & "\" & F & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            wk.Close
            '      oExcel.DisplayAlerts = True
 
 
            'Atmt.SaveAsFile FileName
 
            Kill TmpFileName
            DoEvents
            Debug.Print FileName
 
 
 
        End If
    Next Atmt
 
    Item.UnRead = False
    'Attachment suivant au sein du meme mail
    oExcel.Quit
    Set oExcel = Nothing
 
End Sub

[8Telegraphist8]

Merci Oliv'

Je mets en pratique dès demain matin !

Merci!

[8Telegraphist8]

Hé bien je crois bien que cela fonctionne Oliv'

Merci à toi. Un grand merci pour ton travail qui va beaucoup m'aider ! Si tu étais dans le coin je te paierais une bonne bière !

Bravo et encore merci

Fred