1. #1
    Nouveau Candidat au Club
    Homme Profil pro
    Date manager
    Inscrit en
    mai 2017
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Date manager
    Secteur : Finance

    Informations forums :
    Inscription : mai 2017
    Messages : 2
    Points : 1
    Points
    1

    Par défaut Récupérer une adresse mail dans un corps d'un email

    Bonjour à tous,

    Je travaille sous Outlook 2000.
    Je stocke dans un dossier les rapports des emails non remis aux destinataires (cause : email non valide ou n'existe plus).

    Je souhaite donc récupérer l'adresse mail qui se trouve dans le corps du message de ce rapport de non remise et enregistrer toutes ces adresses emails erronées dans Excel.

    Voici le corps de message "type" :
    Échec de la remise pour ces destinataires ou groupes :
    XXXXX@XXXXX.com
    Le système de messagerie du destinataire est actuellement occupé et ne peut pas accepter de messages. Essayez de renvoyer ce message ultérieurement.

    Voici le code que j'ai récupéré sur un autre topic mais qui ne fonctionne pas :

    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
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    Sub Recup_adresse_mail()
    '
    ''---------------------------------------------------------------------------------------
    ' Procedure : Recup_adresse_mail
    ' Auteur    : Erwan
    ' Date      : 16/09/2008
    ' https://www.developpez.net/forums/d615449/logiciels/microsoft-office/outlook/vba-outlook/recuperer-adresse-mail-corps-message/
    ' Récupére dans une feuille Excel les addresses email contenues dans le corps de message des mails du dossier en cours
    '---------------------------------------------------------------------------------------
     
     
    'Déclaration des variables
    Dim MonOutlook As Outlook.Application
    Dim LesMails As Object
    Dim appExcel As Excel.Application    'Application Excel
    Dim wbExcel As Excel.Workbook    'Classeur Excel
    Dim wsExcel As Excel.Worksheet    'Feuille Excel
    Dim ligne As Integer
    Dim strTemp As String
    Dim intpos As Integer
    Dim intpos_space As Integer
    Dim intpos_bracket As Integer
    Dim intpos_temp As Integer
    Dim bool_trouv As Boolean
     
     
        'Ouverture de l'application
        Set appExcel = CreateObject("Excel.Application")
        appExcel.Visible = True
        appExcel.Workbooks.Add
        Set wbExcel = appExcel.ActiveWorkbook
        Set wsExcel = wbExcel.ActiveSheet
     
        wsExcel.Range("a1").Value = "Adresse Expediteur"
     
     
        ligne = 2
     
        Set MonOutlook = Outlook.Application
        Set LesMails = MonOutlook.ActiveExplorer.Selection
        Set LesMails = MonOutlook.ActiveExplorer.CurrentFolder.Items
     
     
        For Each lemail In LesMails
     
                If (InStr(lemail.Body, "Échec de la remise pour ces destinataires ou groupes :") <> 0) Then
     
                    bool_trouv = True
     
                    'Extract email address from body
                    intpos = InStr(lemail.Body, "@")
                    If intpos <> 0 Then
                        'Get right of @
                        intpos_space = InStr(intpos, lemail.Body, " ")
                        intpos_bracket = InStr(intpos, lemail.Body, ">")
                        If (intpos_space < intpos_bracket) Or (intpos_bracket = 0) Then
                            intpos_temp = intpos_space
                        Else
                            intpos_temp = intpos_bracket
                        End If
                        strTemp = Left(lemail.Body, intpos_temp - 1)
                        'Get left of @
                        intpos_space = InStrRev(strTemp, " ", -1)
                        intpos_bracket = InStrRev(strTemp, "<", -1)
                        If (intpos_space > intpos_bracket) Or (intpos_bracket = 0) Then
                            intpos_temp = intpos_space
                        Else
                            intpos_temp = intpos_bracket
                        End If
                        strTemp = Mid(strTemp, intpos_temp + 1)
     
                    End If
                End If
     
                If bool_trouv = True Then
                    wsExcel.Cells(ligne, 1).Value = strTemp
                    ligne = ligne + 1
                End If
     
        Next lemail
     
        MsgBox "Opération terminée"
     
    End Sub
    Je me place sur le dossier archivé où sont stockés mes emails en question et exécute la macro.
    Excel s'ouvre et seul "Adresse Expediteur" s'affiche en A1.
    Qu'est ce qui ne va pas dans le code ?

    Merci d'avance de vos réponses.

  2. #2
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    2 834
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 2 834
    Points : 4 945
    Points
    4 945
    Billets dans le blog
    12

    Par défaut

    Bjr ca doit etre le test instr qui ne match rien.
    Tu peux ajouter un paramètre pour qu il ne tient pas compte de.la CASSE.



    Ou ajoute en haut du module
    Option compare text

  3. #3
    Nouveau Candidat au Club
    Homme Profil pro
    Date manager
    Inscrit en
    mai 2017
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Date manager
    Secteur : Finance

    Informations forums :
    Inscription : mai 2017
    Messages : 2
    Points : 1
    Points
    1

    Par défaut

    Bonjour Oliv' !

    J'ai refait un test avec un email contenant uniquement le texte ci-dessous et cela fonctionne :
    Échec de la remise pour ces destinataires ou groupes :
    XXX@XXX.com
    Le système de messagerie du destinataire est actuellement occupé et ne peut pas accepter de messages. Essayez de renvoyer ce message ultérieurement.
    Après vérif, le code VNA ne fonctionne pas car l y a des répétitions de l'email en dessous de ce quote (dans le paragraphe "Informations de diagnostic pour les administrateurs")

    Comment faire pour avoir comme résultat le premier email visible dans chaque email ?

    Aussi, le résultat qui apparaît maintenant est le suivant : "mailto:XXX@XXX.com"XXX@XXX.com"
    Est-ce possible de ne conserver que l'email "XXX@XXX.com"et non le "mailto:XXX@XXX.com" ?

  4. #4
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Consultant technique et formateur en recherche active pour le Canada
    Inscrit en
    juillet 2007
    Messages
    11 439
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 33
    Localisation : Royaume-Uni

    Informations professionnelles :
    Activité : Consultant technique et formateur en recherche active pour le Canada
    Secteur : Finance

    Informations forums :
    Inscription : juillet 2007
    Messages : 11 439
    Points : 25 327
    Points
    25 327

    Par défaut

    Salut,

    tu peux tres bien faire une etape intermediaire de "nettoyage"

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Dim strTonBlocMail as String
     
    'alimentation de la variable strTonBlocMail
     
    If Instr(1,strTonBlocMail,"mailto:")=1 Then
     'traitement de nettoyage entre le mailto et le reste du texte
    End if
    Pas de question technique par MP, je ne réponds pas

    Apprendre à programmer avec Access 2016

    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

Discussions similaires

  1. Récupérer une adresse mail?
    Par totodu038 dans le forum Flash
    Réponses: 1
    Dernier message: 07/03/2010, 15h06
  2. Récupérer une adresse mail dans un corps de message
    Par wannie7777 dans le forum VBA Outlook
    Réponses: 11
    Dernier message: 25/09/2008, 12h36
  3. Réponses: 5
    Dernier message: 11/04/2008, 19h12
  4. Réponses: 6
    Dernier message: 12/01/2008, 04h07
  5. Trouver une adresse mail dans un fichier word
    Par vonitiana dans le forum Langage
    Réponses: 18
    Dernier message: 09/06/2006, 17h48

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo