Outlook Macro : sauvegarde mail html outlook

redbulls60

XLDnaute Nouveau
Bonjour la communauté ,

j'essaie de sauvegarder un mail en html à son arrivé en fonction de l'expéditeur.( NewMailEx )
J'ai repris un code de DOLPHY35 que j'essaye d'adapter mais je me retrouve avec une erreur .
Serait il possible d'avoir un coup de pouce ?

VB:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------------------
' Procédure : Application_NewMailEx
' Auteur    : Dolphy35
' Site      : http://dolphy35.developpez.com
' Détail    : Permet de déplacer le nouveau message si celui-ci est envoyé par un expéditeur précis
'---------------------------------------------------------------------------------------
'
    'Déclarations
    Dim MonApp As Outlook.Application
    Dim xMailItem As Outlook.MailItem
    Dim MonMail As Object
    Dim MonNameSpace As Outlook.NameSpace
    Dim MonDossier As Outlook.Folder
    Dim xFilePath As String
    Dim xFileName As String
    Dim xRegEx
    xFilePath = "C:\Users\XXXXXXX" ' chemin de sauvegarde
    
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonDossier = MonNameSpace.GetDefaultFolder(olFolderInbox)
    Set MonMail = Application.Session.GetItemFromID(EntryIDCollection)
    
        If MonMail.SenderEmailAddress = "XXXXXXXX@gmail.com" Then ' mél de la personne à sauvegarder
            xFileName = xRegEx.Replace(xMailItem.Subject, "")
            xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML
        End If
        
End Sub

Bonne journée à tous et prenez soin de vous et de vos proches
 

redbulls60

XLDnaute Nouveau
Bonjour Fanch55 ,

Merci pour la réponse .

Après réflexion , je me suis créer un faux problème . Le plus simple est d'importer les mails pour pouvoir les travailler sous excel .

Voici le code :

VB:
Sub LireMessagerie()

On Error Resume Next

Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxfolder = olns.GetDefaultFolder(6).Folders("test") ' boite de reception // sous dossier test


Sheets("Lire_mail").Select ' feuille dans laquelle on veut les données
On Error Resume Next
N = 1
For Each I In olxfolder.Items

If I.SenderName = "XXXXXXXXXX@XXXXXX.info" Then  ' l'adresse mél pour filtrer

Cells(N, 1).ClearComments
Cells(N, 1) = I.SenderName
Cells(N, 2).ClearComments
Cells(N, 2) = I.Body
Cells(N, 3).ClearComments
Cells(N, 3) = I.CreationTime

N = N + 1

End If ' nouveau
Next



End Sub


Si cela peut aider quelqu'un .
 

Discussions similaires

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi