Sub
parseMails()
Const
FILEPATH =
"D:\emails2.txt"
Set
myRegExp = CreateObject(
"vbscript.regexp"
)
Set
objFSO = CreateObject(
"Scripting.FileSystemObject"
)
Dim
fldr
As
Folder
Set
fldr = Application.GetNamespace(
"MAPI"
).GetFefaultfolder(olPublicFoldersAllPublicFolders).Folders.Item(
"E-Mail Versand"
).Folders.Item(
"Carl"
).Folders.Item(
"Berger"
)
Set
objTextFile = objFSO.CreateTextFile(FILEPATH,
True
)
myRegExp.IgnoreCase =
True
myRegExp.Pattern =
"([A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,6})"
For
i = 1
To
fldr.Items.Count
If
fldr.Items(i).
Class
= olMail
Then
strBody = fldr.Items(i).Body
Set
myMatches = myRegExp.Execute(strBody)
If
myMatches.Count >= 1
Then
For
Each
myMatch
In
myMatches
If
myMatch.SubMatches.Count >= 1
Then
strEMail = myMatch.SubMatches(0)
objTextFile.WriteLine (strEMail)
End
If
Next
End
If
End
If
Next
objTextFile.Close
MsgBox
"Verarbeitung abgeschlossen !"
& vbNewLine &
"Die Datei mit den extrahierten E-Mail-Adressen liegt hier: "
& FILEPATH
Set
myRegExp =
Nothing
Set
objFSO =
Nothing
End
Sub