Macro pour récupéré une donnée dans l'objet d'un mail
1 réponse
benouthepouick
Bonjour,
Je reçois dans une boite mail de nombreux rapports.
Dans l'objet de chaque mail j'ai "NOMDUCLIENT blablabla SUCCES" ou "NOMDUCLIENT blablabla ERREUR".
J'ai ensuite un tableau excel où je reporte pour chaque client si le mail est reçu en succès ou en erreur.
Je pense pouvoir automatiser tout ceci, sauf que j'y connais rien du tout en macro. J'ai donc chercher des choses qui pourrait correspondre, j'ai testé des trucs pour voir ce qui pouvait marcher mais ça ne donne rien.
J'ai trouvé ceci, mais il est clair que bon la moitié est a jeté, mais surtout j'ai une erreur directement à la deuxième ligne... :
Sub LireMessages()
Dim olapp As New Outlook.Application
Dim NS As Object, Dossier As Object
Dim OlExp As Object
Dim i As Object
Dim mybody() As String
Dim fromsender As String
Set NS = olapp.GetNamespace("MAPI")
Set Dossier = NS.Folders("Dossiers personnels").Folders("Boîte de réception")
b = 2
For Each i In Dossier.Items
If i.SenderEmailAddress = "alerte@alerte.com" And i.Subject like "SUCCESS" Then
sujet = i.Subject
mybody = Split(i.Body, vbCrLf)
fromsender = i.SenderEmailAddress
dejafait = True
For compt = 0 To UBound(mybody)
If InStr(1, UCase(mybody(compt)), UCase("ALERTE")) > 0 And dejafait = True Then
alerte = LTrim(Split(mybody(compt), ":")(1))
dejafait = False
End If
If InStr(1, UCase(mybody(compt)), UCase("Point de mesure")) > 0 Then
PointMesure = LTrim(Split(mybody(compt), ":")(1))
End If
If InStr(1, UCase(mybody(compt)), UCase("Situation")) > 0 Then
situation = LTrim(Split(mybody(compt), ":")(1))
End If
If InStr(1, UCase(mybody(compt)), UCase("Seuil")) > 0 Then
seuil = LTrim(Split(mybody(compt), ":")(1))
End If
If InStr(1, UCase(mybody(compt)), UCase("Liste des alertes")) > 0 Then
mydate = Mid(mybody(compt), InStr(1, mybody(compt), "/") - 2, 10)
J'aimerais quelque chose du type : regarde dans la boite de reception, et si l'objet du mail contient la valeur écrit dans la première colonne de mon fichier excel (le nom de tout les clients) et success alors écrit VRAI (en face de la ligne correspondante), si il est écrit Erreur tape faux.
Si quelqu'un peut me donner un début de piste de solution, car j'ai beau chercher sur internet, je trouve rien du tout.... :'(
Merci d'avance !!
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
News.aioe.org
Bonjour, Ajoute la référence suivante "Microsoft Outlook xx Object Library" dans Outils, Références 'de la fenêtre Visual Basic Editor. '---------------------------------------------------------------- Sub LireMessages() Dim olApp As New Outlook.Application, NS As Namespace, Dossier As Folder Dim i As MailItem, Ctr As Long Set fs = CreateObject("Scripting.FileSystemObject") Set olApp = Outlook.Application Set NS = olApp.GetNamespace("MAPI") Set Dossier = NS.Folders(1).Folders("Boîte de Réception") For Each i In Dossier.Items If i.SenderEmailAddress = "" And i.Subject Like "SUCCESS" Then sujet = i.Subject mybody = Split(i.Body, vbCrLf) fromsender = i.SenderEmailAddress dejafait = True For compt = 0 To UBound(mybody) If InStr(1, UCase(mybody(compt)), UCase("ALERTE")) > 0 And dejafait = True Then alerte = LTrim(Split(mybody(compt), ":")(1)) dejafait = False End If If InStr(1, UCase(mybody(compt)), UCase("Point de mesure")) > 0 Then PointMesure = LTrim(Split(mybody(compt), ":")(1)) End If If InStr(1, UCase(mybody(compt)), UCase("Situation")) > 0 Then situation = LTrim(Split(mybody(compt), ":")(1)) End If If InStr(1, UCase(mybody(compt)), UCase("Seuil")) > 0 Then seuil = LTrim(Split(mybody(compt), ":")(1)) End If If InStr(1, UCase(mybody(compt)), UCase("Liste des alertes")) > 0 Then mydate = Mid(mybody(compt), InStr(1, mybody(compt), "/") - 2, 10) End If Next Cells(b, 1) = fromsender Cells(b, 2) = sujet Cells(b, 3) = Format(mydate, "MM/DD/YYYY") Cells(b, 4) = alerte Cells(b, 5) = PointMesure Cells(b, 6) = seuil Cells(b, 7) = situation b = b + 1 End If Next i End Sub '---------------------------------------------------------------- MichD
Bonjour,
Ajoute la référence suivante "Microsoft Outlook xx Object Library" dans
Outils, Références
'de la fenêtre Visual Basic Editor.
'----------------------------------------------------------------
Sub LireMessages()
Dim olApp As New Outlook.Application, NS As Namespace, Dossier As Folder
Dim i As MailItem, Ctr As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")
Set Dossier = NS.Folders(1).Folders("Boîte de Réception")
For Each i In Dossier.Items
If i.SenderEmailAddress = "alerte@alerte.com" And i.Subject Like
"SUCCESS" Then
sujet = i.Subject
mybody = Split(i.Body, vbCrLf)
fromsender = i.SenderEmailAddress
dejafait = True
For compt = 0 To UBound(mybody)
If InStr(1, UCase(mybody(compt)), UCase("ALERTE")) > 0 And
dejafait = True Then
alerte = LTrim(Split(mybody(compt), ":")(1))
dejafait = False
End If
If InStr(1, UCase(mybody(compt)), UCase("Point de mesure")) > 0
Then
PointMesure = LTrim(Split(mybody(compt), ":")(1))
End If
If InStr(1, UCase(mybody(compt)), UCase("Situation")) > 0 Then
situation = LTrim(Split(mybody(compt), ":")(1))
End If
If InStr(1, UCase(mybody(compt)), UCase("Seuil")) > 0 Then
seuil = LTrim(Split(mybody(compt), ":")(1))
End If
If InStr(1, UCase(mybody(compt)), UCase("Liste des alertes")) >
0 Then
mydate = Mid(mybody(compt), InStr(1, mybody(compt), "/") -
2, 10)
Bonjour, Ajoute la référence suivante "Microsoft Outlook xx Object Library" dans Outils, Références 'de la fenêtre Visual Basic Editor. '---------------------------------------------------------------- Sub LireMessages() Dim olApp As New Outlook.Application, NS As Namespace, Dossier As Folder Dim i As MailItem, Ctr As Long Set fs = CreateObject("Scripting.FileSystemObject") Set olApp = Outlook.Application Set NS = olApp.GetNamespace("MAPI") Set Dossier = NS.Folders(1).Folders("Boîte de Réception") For Each i In Dossier.Items If i.SenderEmailAddress = "" And i.Subject Like "SUCCESS" Then sujet = i.Subject mybody = Split(i.Body, vbCrLf) fromsender = i.SenderEmailAddress dejafait = True For compt = 0 To UBound(mybody) If InStr(1, UCase(mybody(compt)), UCase("ALERTE")) > 0 And dejafait = True Then alerte = LTrim(Split(mybody(compt), ":")(1)) dejafait = False End If If InStr(1, UCase(mybody(compt)), UCase("Point de mesure")) > 0 Then PointMesure = LTrim(Split(mybody(compt), ":")(1)) End If If InStr(1, UCase(mybody(compt)), UCase("Situation")) > 0 Then situation = LTrim(Split(mybody(compt), ":")(1)) End If If InStr(1, UCase(mybody(compt)), UCase("Seuil")) > 0 Then seuil = LTrim(Split(mybody(compt), ":")(1)) End If If InStr(1, UCase(mybody(compt)), UCase("Liste des alertes")) > 0 Then mydate = Mid(mybody(compt), InStr(1, mybody(compt), "/") - 2, 10) End If Next Cells(b, 1) = fromsender Cells(b, 2) = sujet Cells(b, 3) = Format(mydate, "MM/DD/YYYY") Cells(b, 4) = alerte Cells(b, 5) = PointMesure Cells(b, 6) = seuil Cells(b, 7) = situation b = b + 1 End If Next i End Sub '---------------------------------------------------------------- MichD