Discussion :

[jmsimon]

Salut,

je voudrais extraire l'adresse mail contenue dans le corps d'un mail ainsi que ce qui suit la mention "Remote Server returned ''

comment puis-je faire avec un script

Merci

[Oliv-]

BOnsoir,
Alors tu parles me semble t'il d'un "olReport"
Pour arriver à tes fins, tu peux utiliser la fonction "split()" , ou instr() ou les regex sur le .body de l'item.

En principe tu as également une pièce jointe qui est le Mail d'origine.


voici des exemples

http://www.developpez.net/forums/d50...l/#post3022445

http://www.developpez.net/forums/blo...nvoye-message/

[jmsimon]

BOnsoir,
Alors tu parles me semble t'il d'un "olReport"
Pour arriver à tes fins, tu peux utiliser la fonction "split()" , ou instr() ou les regex sur le .body de l'item.

En principe tu as également une pièce jointe qui est le Mail d'origine.


voici des exemples

http://www.developpez.net/forums/d50...l/#post3022445

http://www.developpez.net/forums/blo...nvoye-message/

heu.....désolé je connais rien en VB

ce que je veux c'est extraire 3 ligne dans des postmaster qui ce présente ainsi :

le mail du user : toto@truc.fr
le serveyr : Server.domaine.fr
message d'erreur : Remote Server returned '<blablablablablablablablablablablablablablablablablablablablabla>'

si tu as un moyen simple j'en ai 1200 a extraire

[Oliv-]

Bonjour,
Si tu ne connais rien en VBA, ce n'est plus de l'aide pour un développement que tu as besoin mais un programme tout fait !

Le principe est de rechercher des mots significatifs pour trouver à partir de leur position les infos dont tu as besoin (et ensuite les mettre je suppose dans un fichier excel.)

Voici un exemple avec REDEMPTION (http://www.dimastr.com/redemption), pour obtenir les infos du rapport

http://www.developpez.net/forums/d61...e/#post3653079

[jmsimon]

hello,

j'ai repris ce script pour extraire le contenu du corps de mails avec les RegEx

mais j'ai une erreur 13 sur la ligne "rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row"
et je voudrais que le script parcours tous les mails dans le dossier.

mais j'suis un peux nul en VB

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
85
86
 
Sub CopyToExcel()
'Dim olItem As Outlook.MailItem
'Dim olItem As Object
Dim xlApp As Object
Dim xlWB As Object
Dim xlUp As Object
Dim xlSheet As Object
Dim vText, vText2, vText3, vText4, vText5 As Variant
Dim sText As String
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object
Dim i As Long
 
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\Desktop\mails.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("mails")
Set olItem = Application.ActiveExplorer().Selection(1)
 
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
rCount = rCount + 1
 
sText = olItem.Body
 
Set Reg1 = CreateObject("VBScript.RegExp")
 
For i = 1 To 3
 
With Reg1
Select Case i
Case 1
.Pattern = "([A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,})"
Case 2
.Pattern = "([\d]*\.[\d]*)\s*\n"
Case 3
.Pattern = "(Remote Server(.*)\n)"
End Select
End With
 
If Reg1.Test(sText) Then
Set M1 = Reg1.Execute(sText)
For Each M In M1
Select Case i
Case 1
vText = Trim(M.SubMatches(0))
Case 2
vText2 = Trim(M.SubMatches(0))
Case 3
vText3 = Trim(M.SubMatches(0))
End Select
Next
End If
 
Next i
xlSheet.Range("b" & rCount) = vText
xlSheet.Range("c" & rCount) = vText2
xlSheet.Range("d" & rCount) = vText3
 
xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If
Set M = Nothing
Set M1 = Nothing
Set Reg1 = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

merci pour vos reponses