Sauvegarde de mail via excel

Version imprimable

17/05/2019, 10h47
vince151222

Sauvegarde de mail via excel
Bonjour,
Je suis confronté à un problème, je souhaite sauvegarder un mail envoyé automatiquement depuis excel via outlook dans un répertoire.
Cependant, on un .SaveAs avant un .send sauvegarde la version "display" du mail, sinon en essayant après cela retourne une erreur (l'objet mail a été vidé ou supprimé).
J'ai donc essayé de récupérer dans la boite d'envoie le mail, ce qui fonctionne mais je dois alors pouvoir désactiver les règles outlook (tout en restant 100% sur excel), car le module s'appliquera à plusieurs boites mails différentes traitant et déplaçant parfois les mails envoyés dans d'autre dossier .
Donc je viens vers vous pour connaître la solution à une des deux propositions :
1. Sauvegarder un mail après un .send
2. Désactiver les règles Outlook depuis Excel
Merci beaucoup. :D
17/05/2019, 11h49
Menhir

Et en faire un PDF, ça ne pourrait pas convenir ?
17/05/2019, 13h03
patricktoulon

re

Bonjour

je pige pas tres bien ton soucis
tu pourrais selon moi sauvegarder tout simplement le bodyhtml du mail.item même dans un .txt
je dis ca Outlook n'est pas mon point fort je suis plutôt CDO mais il me semble qu'il y a une propertie htmlbody ou bodyhtml (comme CDO) pour Outlook aussi donc y a plus qu'a
tu pourrais ajouter en fin de txt les destinataires nom des pieces jointes etc......
je dis ca juste comme ca en passant ;)
17/05/2019, 13h20
vince151222

MAJ

Alors, le product owner souhaite un .msg :? J'ai finalement contourné le problème en attrapant le mail dans les mails envoyés en prenant soin de désactiver les règles d'Outlook avant puis les réactiver après.
(Etant nouveau sur le forum, je ne sais pas si dois-je le passer en résolue ? Même si le problème d'origine n'a pas été résolue mais contourné)
Merci pour votre temps !

Cordialement
17/05/2019, 15h16
patricktoulon

re

re
c'est le code qui serait intéressant de voir
ca pourrait servir au autres

Code suavegarde de mail alternatif

Code:

1
2
3
4
5
6
7
8
gestionRules.DesactivateRule 'désactivation des règles appliqué dans l'application Outlook
            myItem.DeleteAfterSubmit = False 'On active la copie dans les "éléments envoyés"
            myItem.Display  'Afficher le brouillon
            Chargement.Show 'Bouton de chargement (pour faire patienter l'utilisateur)
 
            Set ns = ol.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail) 
            ns.Items(ns.Items.Count).SaveAs ThisWorkbook.Path & "\RNC\" & titre & "Dir\" & titre & ".msg"  'Sauvegarde du dernier message de la boite "Éléments envoyés"
            gestionRules.ActivateRule    'Réactivation des règles

il existe deux procédures pour désactiver les règles d'une application Outlook

Code:

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
 
Public tableau(20)
Sub DesactivateRule()
    Dim oFromCondition As Object
    Set OutApp = CreateObject("Outlook.Application")
    Dim st As Outlook.Store
    Dim myRules As Outlook.Rules
    Dim rl As Outlook.Rule
    Dim i As Integer
    ' récupération l'emplacement de stockage des règles
    Set st = OutApp.Session.DefaultStore
    ' récupération de toutes les règles disponibles
    Set myRules = st.GetRules
    ' Parcours de chaque règle
    i = 0
    For Each rl In myRules
        If rl.Enabled = True Then
            rl.Enabled = False
        Else
            tableau(i) = rl.Name
            i = i + 1
        End If
    Next
    myRules.Save
 
End Sub
 
Sub ActivateRule()
    Dim oFromCondition As Object
    Set OutApp = CreateObject("Outlook.Application")
    Dim st As Outlook.Store
    Dim myRules As Outlook.Rules
    Dim rl As Outlook.Rule
 
    ' récupération l'emplacement de stockage des règles
    Set st = OutApp.Session.DefaultStore
    ' récupération de toutes les règles disponibles
    Set myRules = st.GetRules
 
    ' Parcours de chaque règle
    For Each rl In myRules
        If Not present(tableau, rl.Name) Then rl.Enabled = True
    Next
    myRules.Save
End Sub
 
Function present(tableau, nom)
    For i = 0 To UBound(tableau)
        If tableau(i) = nom Then present = True
    Next
End Function