Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Mail Delivery Error - Schluss mit einzeln rauskopieren

Anleitung Entwicklung VB for Applications

Mitglied: d4shoerncheN

d4shoerncheN (Level 2) - Jetzt verbinden

02.08.2013 um 10:19 Uhr, 4091 Aufrufe, 1 Kommentar, 5 Danke

Outlook 2010

Liebe Kollegen,

ich hoffe das mit dieser Anleitung auch einige Leute etwas anfangen können. Wir betreiben ein Newsletter-System welches regelmäßig verwendet wird. Hin und wieder kommt es vor (aus Altbeständen) das einige Adressen nicht mehr gültig sind und mit einer Mail Delivery Error Meldung zurück kommen. Je nach Anzahl kann dies sehr mühselig sein alle E-Mail Adressen rauszukopieren und zu analysieren.

Vor diesem Problem stand ich und möchte mich recht Herzlich bei @colinardo bedanken, der mir die Lösung präsentierte. Hierbei werden alle E-Mails überprüft und die in der Fehlermeldung erhaltenen E-Mailadressen in eine separate Textdatei gespeichert.

1. Öffnet Outlook 2010
2. Verschiebt die Mail Delivery Error Meldungen in einen seperaten Ordner, am besten in das Root-Verzeichnis
3. Mit ALT + F11 könnt Ihr den VBA Editor öffnen
4. Hier bei Projekt 1 bis zur ThisOutlookSession durchklicken und nachfolgenden Code einfügen

01.
Sub parseMails() 
02.
    Const FILEPATH = "###1###" 
03.
     
04.
    Set myRegExp = CreateObject("vbscript.regexp") 
05.
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
06.
    Dim fldr As Folder 
07.
    Set fldr = Application.Session.Stores.Item("###2###").GetRootFolder.Folders("###3###") 
08.
    Set objTextFile = objFSO.CreateTextFile(FILEPATH, True) 
09.
    myRegExp.IgnoreCase = True 
10.
    myRegExp.Pattern = "([A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,6})" 
11.
     
12.
    For i = 1 To fldr.Items.Count 
13.
            strBody = fldr.Items(i).Body 
14.
            Set myMatches = myRegExp.Execute(strBody) 
15.
            If myMatches.Count >= 1 Then 
16.
                For Each myMatch In myMatches 
17.
                    If myMatch.SubMatches.Count >= 1 Then 
18.
                        strEMail = myMatch.SubMatches(0) 
19.
                        objTextFile.WriteLine (strEMail) 
20.
                    End If 
21.
                Next 
22.
            End If 
23.
    Next 
24.
 
25.
    objTextFile.Close 
26.
    MsgBox "Verarbeitung abgeschlossen !" & vbNewLine & "Die Datei mit den extrahierten E-Mail-Adressen liegt hier: " & FILEPATH 
27.
    Set myRegExp = Nothing 
28.
    Set objFSO = Nothing 
29.
End Sub
###1### Hier fügt Ihr den Pfad und den Dateinamen ein, wo die Datei abgespeichert werden soll. Bei mir gab es kleine Probleme mit Laufwerk C, somit habe ich es auf D:\emails.txt geändert.

###2### Hier der Name des Root-Knoten (Stores) Eures Profils. Bei mir war es meine E-Mail Adresse.

###3### Hier den Namen des Ordners eintragen, indem Eure Meldungen liegen.

5.Script ausführen.

Hier der komplette Beitrag:
http://www.administrator.de/content/detail.php?id=213100#comment-860454

Gruß
@d4shoerncheN
Mitglied: colinardo
02.08.2013, aktualisiert um 11:35 Uhr
Hi @d4shoerncheN,
danke für deine Anleitung. Zu erwähnen sei noch, dass das obige Script nur die erste E-Mail-Adresse im Body der Mail extrahiert.
Ergänzend zum obigen Script hier noch eine Variante mit der man festlegen kann an welcher Position die Mail-Adresse extrahiert werden soll:
An Position ###4### trägt man dann die Position der E-Mail-Adresse als Zahl ein.
Beispiel: Wenn im NDR-Report die gewünschte Mail-Adresse erst die dritte genannte Mail-Adresse vom Anfang aus gesehen ist trägt man hier eine 3 ein.
01.
Sub parseMails() 
02.
    Const FILEPATH = "###1###" 
03.
     
04.
    Set myRegExp = CreateObject("vbscript.regexp") 
05.
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
06.
    Dim fldr As Folder 
07.
    Set fldr = Application.Session.Stores.Item("###2###").GetRootFolder.Folders("###3###") 
08.
    Set objTextFile = objFSO.CreateTextFile(FILEPATH, True) 
09.
    myRegExp.Global = True 
10.
    myRegExp.IgnoreCase = True 
11.
    myRegExp.Pattern = "([A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,6})" 
12.
     
13.
    For i = 1 To fldr.Items.Count 
14.
            strBody = fldr.Items(i).Body 
15.
            Set myMatches = myRegExp.Execute(strBody) 
16.
           If myMatches.Count > 1 Then 
17.
                intPosition = ###4### 
18.
                If myMatches(intPosition - 1).SubMatches.Count >= 1 Then 
19.
                    strEMail = myMatches(intPosition - 1).SubMatches(0) 
20.
                    objTextFile.WriteLine (strEMail) 
21.
                End If 
22.
           End If 
23.
    Next 
24.
    objTextFile.Close 
25.
    MsgBox "Verarbeitung abgeschlossen !" & vbNewLine & "Die Datei mit den extrahierten E-Mail-Adressen liegt hier: " & FILEPATH 
26.
    Set myRegExp = Nothing 
27.
    Set objFSO = Nothing 
28.
End Sub
Grüße Uwe
Bitte warten ..
Neuester Wissensbeitrag
Ähnliche Inhalte
VB for Applications
gelöst VBA Outlook - Mail delivery system (5)

Frage von carolin.zelda zum Thema VB for Applications ...

E-Mail
gelöst Plesk 17 - E-Mail zurückgestellt in Warteschlange (7)

Frage von ZeldaFreak zum Thema E-Mail ...

Windows 8
gelöst Active Directory Default User.v2 Profile - Windows 8.1 Apps Error (4)

Frage von adm2015 zum Thema Windows 8 ...

Heiß diskutierte Inhalte
Windows Userverwaltung
Ausgeschiedene Mitarbeiter im Unternehmen - was tun mit den AD Konten? (33)

Frage von patz223 zum Thema Windows Userverwaltung ...

LAN, WAN, Wireless
FritzBox, zwei Server, verschiedene Netze (21)

Frage von DavidGl zum Thema LAN, WAN, Wireless ...

Viren und Trojaner
Aufgepasst: Neue Ransomware Goldeneye verbreitet sich rasant (20)

Link von Penny.Cilin zum Thema Viren und Trojaner ...