MACRO: Répondre à un mail avec une adresse se trouvant le corps du message

[roidurif]

Bonjour à tous,

Je voudrais créer une macro qui permettrait de l'executer pour :
- rechercher les ou l'adresse(s) e-mail (Pour : et CC) à laquelle je dois répondre qui se trouve dans le mail.
- Mettre en destinataire les ou l'adresse(s) trouvée dans le mail initial
- Enfin, envoyer la réponse à partir du script.

Voici un Exemple de mail reçu :

Sylvie COUCOU
Assistante
01.11.11.11.11

----- Réacheminé par Sylvie COUCOU/A/PG/TRE/FR le 01/06/2010 10:51 ----- 
	BOITE-ADM-TRE 
Envoyé par : Pierre
31/05/2010 14:35 	
        Pour :        BOITE-FOUR-CENT/F/PS/TRE/FR, BOITE-GP/F/PS/TRE/FR 
        cc :        Robert-externe CHAMB/E/PS/TRE/FR, christian.Bowaer@TRE.com, Laure FAUVE/A/PS/TRE/FR@TRE, Luc ROBERT/A/PS/TRE/FR@TRE 
        Objet :        RE RE Fichier Lien



Bonjour, 

Xxxxxxxxxxxx
Xxxx

Xxxx

Je ne sais vraiment pas comment faire. en cherchant sur des forums, j'ai trouvé deux trois petits indices mais rien de bien concrets, et je ne sais pas comment l'excuter?

Sub recherche_Email_dans_body(LeMail As MailItem)
 
Dim MonOutlook As Outlook.Application
'Dim LeMail As Outlook.MailItem
'Set LeMail = ActiveInspector.CurrentItem
OuCommenceAdresse = InStr(1, LeMail.Body, "mail to : ")
        If OuCommenceAdresse > 0 Then
            OuEstArobase = InStr(OuCommenceAdresse + 10, LeMail.Body, "@")
            
            OuEstEspace = InStr(OuEstArobase, LeMail.Body, " ")
            OuEstparagraphe = InStr(OuEstArobase, LeMail.Body, Chr(10))
            OuEstFinParagraphe = InStr(OuEstArobase, LeMail.Body, Chr(13))
            OuEstcote = InStr(OuEstArobase, LeMail.Body, """")
            Fin = ListMin(OuEstEspace, OuEstparagraphe, OuEstFinParagraphe, OuEstcote)
 
            AdresseEmail = Mid(LeMail.Body, OuCommenceAdresse + 10, Fin - OuCommenceAdresse - 10)
        End If
 
 
Set LeMail = Nothing
MsgBox "[" & AdresseEmail & "]"
End Sub
 
Public Function ListMin(ParamArray ListItems() As Variant)
        Dim I As Integer
     
        For I = 0 To UBound(ListItems())
            If ListMin = "" Then ListMin = ListItems(I)
            If ListItems(I) < ListMin Then ListMin = ListItems(I)
        Next I
End Function

Merci pour votre aide

 

[roidurif]

Re : MACRO: Répondre à un mail avec une adresse se trouvant le corps du message

Bonjour à tous,

J'avance petit à petit, voici ce que j'ai reussi à faire pour le premier point :

- rechercher les ou l'adresse(s) e-mail (Pour : et CC) à laquelle je dois répondre qui se trouve dans le mail.

Sub RechercheEmail2()
 
Dim MonOutlook As Outlook.Application
Dim LeMail As Outlook.MailItem
Set LeMail = ActiveInspector.CurrentItem
Dim Code_LNotes As String

AdresseEmail = "cc :"
         
         DebutEmail = InStr(LeMail.Body, AdresseEmail)
        If DebutEmail > 0 Then
            FinEmail = InStr(DebutEmail, LeMail.Body, "Objet :")
            Email = Mid(LeMail.Body, DebutEmail + 12, FinEmail - DebutEmail - 20)
        End If
Set LeMail = Nothing
 
 'Code Lotus Notes à rechercher
 Code_LNotes = Mid(Email, InStr(1, Email, "/"), 12)
 
'Remplaces caractères dans les adresses mails
 Email = Replace(Email, ",", ";")
 Email = Replace(Email, "-externe", "")
 
'******JE BLOQUE A PARTIR D'ICI***********
i = Code_LNotes
For Each i In Email
  i.Value = Replace(Email, Code_LNotes, "")
Next i
 
 
MsgBox "[" & Email & "]"

Set LeMail = ActiveInspector.CurrentItem
LeMail.To = Email
LeMail.Send

End Sub

Je bloque pour ce code, je souhaite remplacer ou supprimé cette chaine de caractere ressemblant à cela "/F/PS/TRE/FR" dans l'adresse cc :

J'essaie ce code mais ca n'a pas l'aire de marché.

i = Code_LNotes
For Each i In Email
  i.Value = Replace(Email, Code_LNotes, "")
Next i

Puis il me restera ces deux points :
- Mettre en destinataire les ou l'adresse(s) trouvée dans le mail initial
- Enfin, envoyer la réponse à partir du script.

Voici un Exemple de mail reçu :

Sylvie COUCOU
Assistante
01.11.11.11.11

----- Réacheminé par Sylvie COUCOU/A/PG/TRE/FR le 01/06/2010 10:51 ----- 
	BOITE-ADM-TRE 
Envoyé par : Pierre
31/05/2010 14:35 	
        Pour :        BOITE-FOUR-CENT/F/PS/TRE/FR, BOITE-GP/F/PS/TRE/FR 
        cc :        Robert-externe CHAMB/E/PS/TRE/FR, christian.Bowaer@TRE.com, Laure FAUVE/A/PS/TRE/FR@TRE, Luc ROBERT/A/PS/TRE/FR@TRE 
        Objet :        RE RE Fichier Lien



Bonjour, 

Xxxxxxxxxxxx
Xxxx

Xxxx

Merci pour votre aide