Suche nach Email Adressen im Email Text

Forumthread: Suche nach Email Adressen im Email Text

10.09.2013 12:10:28

Stefan

Hallo, wie kann ich EMail Adressen aus dem Emailtext von Emails in einem bestimmten Outlook-Ordner erfassen?
Also: Suche im Text jeder Email in Ordner X nach EMail-Adressen und gib diese in Spalte A untereinander aus.
Könnt Ihr mir dabei helfen?
Hintergrund: Ich muss veraltete Emailadressen herausfiltern, um diese im System dann löschen zu können. Die Info steckt in den Server Error Messages beim Email Versand.
Vielen Dank und liebe Grüße
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

"\b(\w[-.\w]*@\w[-.\w]*\.[a-zA-Z]{2,10})\b"

10.09.2013 17:41:01

ransi

HAllo Stefan
Ich nutze kein Outlook daher kann ich dir nicht helfen die Emailtexte in eine Stringvariable zu laden.
Da gibts hier aber genug schlaue Köpfe die das können ;-)
Diese Funktion extrahiert dann alle gültigen Emailadressen aus der Variablen.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub aufruf()
    Dim arr As Variant
    Dim stext As String
    stext = "123@we.deko efg miuz.dfg234@lkiu.com lkki abc"
    arr = Email_Filter(stext)
    Range("a1").Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)
End Sub

Public Function Email_Filter(strMailtext As String) As Variant
    Dim varTmp() As Variant
    Dim Regex As Object
    Dim M
    Dim Treffer
    Dim lngIndex As Long
    Set Regex = CreateObject("Vbscript.regexp")
    With Regex
        .Pattern = "\b(\w[-.\w]*@\w[-.\w]*\.[a-zA-Z]{2,10})\b"
        .IgnoreCase = True
        .Global = True
        If .test(strMailtext) = True Then
            Set Treffer = .Execute(strMailtext)
            Redim varTmp(Treffer.Count - 1)
            For Each M In Treffer
                varTmp(lngIndex) = M.Value
                lngIndex = lngIndex + 1
            Next
        End If
    End With
    Email_Filter = varTmp
End Function

ransi

AW: "\b(\w[-.\w]*@\w[-.\w]*\.[a-zA-Z]{2,10})\b"

11.09.2013 08:18:10

Stefan

Hi, ohje, vielen Dank an dieser Stelle!
Kann mir hier jemadn weiter helfen?
Danke und Grüße
Stefan

noch offen

11.09.2013 21:37:07

ransi

o T

AW: Suche nach Email Adressen im Email Text

16.09.2013 14:45:56

Stefan

hmm, scheint doch etwas verzwickter zu sein.
hat jemand eine Idee, wie man das umsetzen kann?
Danke und liebe Grüße
Stefan

AW: Suche nach Email Adressen im Email Text

16.09.2013 22:39:57

Bastian

Hallo Stefan,
zusammen mit Ransis Funktion könnte das so aussehen:
"Mein Ordner" ist ein Unterordner des Posteingangs.
Der Mailinhalt aller Mails in "Mein Ordner" wird in die Variable strBody geschrieben.
Diese wird dann der Funktion von Ransi übergeben.

Sub Outlook_Import()
Dim appOutlook As Outlook.Application
Dim OutlookNameSpace As Outlook.Namespace
Dim OutlookMAPIFolder As Outlook.MAPIFolder
Dim OutlookItem As Outlook.MailItem
Dim arr As Variant
Dim strBody As String
Set appOutlook = CreateObject("Outlook.Application")
Set OutlookNameSpace = appOutlook.GetNamespace("MAPI")
Set OutlookMAPIFolder = OutlookNameSpace.GetDefaultFolder(olFolderInbox).Folders("Mein  _
Ordner")
With OutlookMAPIFolder
For Each OutlookItem In .Items
strBody = strBody & OutlookItem.Body
Next OutlookItem
End With
arr = Email_Filter(strBody)
Range("A1").Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)
End Sub
Public Function Email_Filter(strMailtext As String) As Variant
Dim varTmp() As Variant
Dim Regex As Object
Dim M
Dim Treffer
Dim lngIndex As Long
Set Regex = CreateObject("Vbscript.regexp")
With Regex
.Pattern = "\b(\w[-.\w]*@\w[-.\w]*\.[a-zA-Z]{2,10})\b"
.IgnoreCase = True
.Global = True
If .test(strMailtext) = True Then
Set Treffer = .Execute(strMailtext)
ReDim varTmp(Treffer.Count - 1)
For Each M In Treffer
varTmp(lngIndex) = M.Value
lngIndex = lngIndex + 1
Next
End If
End With
Email_Filter = varTmp
End Function

Gruß, Bastian

Beliebteste Forumthreads (12 Monate)

Suche nach Email Adressen im Email Text

Forumthread: Suche nach Email Adressen im Email Text

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Suche nach Email Adressen im Email Text

Forumthread: Suche nach Email Adressen im Email Text

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread