Discussion :

[tibou22]

Bonjour à tous et toutes,

Nous utilisions une macro sous outlook 2003 qui permettait d'enregistrer automatiquement des mails envoyés sur un disque dur (via une boite de dialogue).

Lors de notre passage à Outllook 2013, la macro ne fonctionne plus, plus précisément elle fonctionne jusqu'au display du mail mais l'appel de la fonction "Enregistrer sous" ne se fait plus.

Ci-dessous le code utilisé, si quelqu'un a une idée ?!

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
Dim WithEvents colSentItems As Items
 
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub colSentItems_ItemAdd(ByVal Item As Object)
'By Oliv ' janv 2008 pour Outlook 2003 feat. Sue Mosher 'http://www.outlookcode.com/codedetail.aspx?id=456
    If Item.Class = olMail Then
        Enrg = MsgBox(Item.Subject & vbCr & "Voulez-vous enregistrer ce mail sur le serveur?", vbYesNo)
        If Enrg = vbYes Then
            Item.Display
            Dim objInsp
            Dim colCB
            Dim objCBB
            On Error Resume Next
            Set objInsp = Item.GetInspector
            Set colCB = objInsp.CommandBars
            Set objCBB = colCB.FindControl(, 748) 'enregistrer  sous
        If Not objCBB Is Nothing Then
            objCBB.Execute
        End If
        ElseIf Enrg = vbNo Then
            Item.Close olDiscard
        End If
    End If
End Sub

[Oliv-]

Bonjour essaye avec cela à la place des lignes 20 à 24

Code :

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

1
2
3
 
 
    objInsp.CommandBars.ExecuteMso ("FileSaveAs")

[tibou22]

Merci Oliv-,
cela fonctionne avec ta correction

je reposte le code en entier avec la modification si jamais un jour quelqu'un en a besoin.

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
Dim WithEvents colSentItems As Items
 
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub colSentItems_ItemAdd(ByVal Item As Object)
'Attapted By Oliv ' juil 2014 pour Outlook 2013 From an original idea of Oliv janv 2008 pour Outlook 2003 feat. Sue Mosher 'http://www.outlookcode.com/codedetail.aspx?id=456
    If Item.Class = olMail Then
        Enrg = MsgBox(Item.Subject & vbCr & "Voulez-vous enregistrer ce mail sur le serveur?", vbYesNo)
        If Enrg = vbYes Then
            Item.Display
            Dim objInsp
            Dim colCB
            Dim objCBB
            On Error Resume Next
            Set objInsp = Item.GetInspector
            objInsp.CommandBars.ExecuteMso ("FileSaveAs")
        ElseIf Enrg = vbNo Then
            Item.Close olDiscard
        End If
    End If
End Sub