Hallo zusammen,
und zwar habe ich folgendes Problem: Wir arbeiten mit einem Newslettersystem und bekommen sehr oft Emails zurück, die wie folgt aussehen:
This message was created automatically by mail delivery software.
A message that you sent could not be delivered to one or more of its recipients. This is a permanent error. The following address(es) failed:
HYPERLINK DER EMAILADRESSE
retry timeout exceeded
Nun würden ich gerne die Email-Adressen extrahiert haben.
In einem anderen Forum habe ich schon ein Programm gefunden, welches Emails aus den Mail delivery fails in ein Word-Dokument extrahieren soll.
Unsere Ordnerstruktur:
Öffentliche Ordner - Emailadresse des Benutzers
Alle Öffentlichen Ordner
E-Mail Versand
Carl
Berger
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
Wenn ich das Programm nun ausführe kommt allerdings die Fehlermeldung:
Laufzeitfehler '438'
Objekt unterstützt diese Eigenschaft oder Methode nicht
Woran könnte das liegen? |