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
|
Sub Test()
Dim MonOutlook As Outlook.Application
Dim LeMail As Object
Dim LesMails As Outlook.Selection
Set MonOutlook = Outlook.Application
Set LesMails = MonOutlook.ActiveExplorer.Selection
For Each LeMail In LesMails
Expéditeur = Trouve_Expéditeur(LeMail)
MsgBox Expéditeur
Next LeMail
Set LesMails = Nothing
End Sub
Function Trouve_Expéditeur(LeMail)
Lecorps = Split(LeMail.body, vbCrLf)
For i = 0 To UBound(Lecorps)
If InStr(Lecorps(i), "[") <> 0 Then
Début = InStr(Trim(Lecorps(i)), "[") + 8
Longueur = InStrRev(Trim(Lecorps(i)), "]") - Début
Adresse = Mid(Lecorps(i), Début, Longueur)
Trouve_Expéditeur = Adresse
Exit Function
End If
Next
End Function |
Partager