Bonjour à tous,
J'ai créé une macro qui est destinée à enregistrer les PJ des mails d'une boite Outlook donnée, hier elle marchait nickel et aujourd hui ca me met une erreur alors qu aucune modif n'a été faite entre temps.
L erreur est la suivante :
La méthode Attachments de l'objet oMailItem a échoué
Avez vous une idée?
Merci d'avance
Ci joint 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 Public Sub GetFromInbox() 'Macro permettant d'obtenir le PJ des mails d'une boite mail donnée Dim olApp As Outlook.Application Dim olNs As Outlook.Namespace ' Dim Fldr As MAPIFolder Dim Fldr As Outlook.MAPIFolder ' Dim OLmail As Variant Dim OLmail As Outlook.MailItem Dim myRecipient As Outlook.Recipient Dim i As Integer, j As Integer Dim pceJointe As Outlook.Attachment, strInfo As String Dim dossier As String Dim fld As FileDialog Dim fg As MAPIFolder 'initialiser l'objet Outlook : Set olApp = CreateObject("Outlook.Application") olApp.Session.Logon Set olNs = olApp.GetNamespace("MAPI") 'Définir la boîte à lettre à prendre en compte : Set myRecipient = olNs.CreateRecipient("DED CWT-PAR") myRecipient.Resolve 'si la boîte à lettre existe bien alors définir le répertoire : If myRecipient.Resolved Then Set Fldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox).Parent.Folders("01 DED") End If i = 1 'lancer la boîte de dialog de sélection du répertoire à copier: Set fld = Application.FileDialog(msoFileDialogFolderPicker) fld.Show 'si on a sélection rien alors If fld.SelectedItems.Count > 0 Then dossier = fld.SelectedItems(1) Else Exit Sub For Each OLmail In Fldr.Items With OLmail If .Attachments.Count > 0 Then For Each pceJointe In OLmail.Attachments 'traitement des PJ Next pceJointe End If i = i + 1 End With Next OLmail MsgBox "Enregistrement terminé" Set Fldr = Nothing Set olNs = Nothing Set olApp = Nothing End Sub
Partager