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