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

Outlook Anhänge aus Mails automatisch exoprtieren - Nur möglich bei manuellem Anstarten des Scriptes

Frage Entwicklung VB for Applications

Mitglied: Paul1896

Paul1896 (Level 1) - Jetzt verbinden

04.09.2014 um 15:01 Uhr, 1098 Aufrufe, 5 Kommentare, 1 Danke

Hallo zusammen,

ich bin kein Experte in Sachen VBA. Ich habe mir nun ein Makro zusammengesucht und angepasst, welches mir Mailanhänge extrahieren soll und in ein bestimmtes Verzeichnis legen soll. Danach soll das Skript die Mail löschen. Das klappt auch soweit, wenn ich das Marko in "ThisOutlookSession" einfüge und per F5 anstarte. Aber es bearbeitet immer nur eine ungelesene Mail im Postfach, unabhängig davon wie viele ungelesene Mails im Posteingang liegen. Nach meinem Verständnis, sollte das Skript aber automatisch alle Mails durchlaufen und sie bearbeiten.

Wäre schön wenn ich hier eine Lösung finden könnte.

01.
Private Sub Application_NewMail() 
02.
Dim Foldername As String 
03.
Dim objIn As MAPIFolder 
04.
Dim objNewMail As MailItem 
05.
 
06.
On Error Resume Next 
07.
Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
08.
For Each objNewMail In objIn.Items 
09.
    With objNewMail 
10.
        If .UnRead = True Then 
11.
            NumberOfMails = .Attachments.Count 
12.
            If NumberOfMails > 0 Then 
13.
                Foldername = "C:\temp\ " 
14.
                MkDir Foldername 
15.
                For i = 1 To NumberOfMails 
16.
                    .Attachments.Item(i).SaveAsFile Foldername & "" _ 
17.
                                           & .Attachments.Item(i).FileName 
18.
                Next i 
19.
                objNewMail.Delete 
20.
            End If 
21.
        End If 
22.
    End With 
23.
Next objNewMail 
24.
EndSub
Mitglied: colinardo
04.09.2014, aktualisiert um 18:49 Uhr
Moin Paul1896,
in deinem Code sind einige Fehler drin, und wegen des On Error Resume Next bekommst du diese nicht angezeigt
Z.B. prüfst du nicht ob der Ordner C:\temp schon vorhanden ist, und wenn dann der Code versucht diesen mit mkdir anzulegen läuft es auf einen Fehler und bricht ab.
Der nächste Fehler ist das Löschen der Mail innerhalb der Foreach-Schleife. Das geht so auch nicht denn du veränderst damit die Auflistung der Items der Schleife. Hier sollte man die Mails welche gelöscht werden sollen, einer "Custom-Collection" hinzufügen und erst zum Schluss alle zusammen löschen.

Dein Code sähe dann so aus (aber bitte auch unten weiterlesen, dort gibt es eine bessere Variante):
01.
Private Sub Application_NewMail() 
02.
Dim Foldername As String, objIn As MAPIFolder, objNewMail As Object, fso as Object, colDelete as New Collection, mail as MailItem 
03.
Set fso = CreateObject("Scripting.FilesystemObject") 
04.
 
05.
Foldername = "C:\temp" 
06.
If Not fso.FolderExists(Foldername) Then 
07.
  MkDir Foldername 
08.
End If 
09.
 
10.
Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
11.
For Each objNewMail In objIn.Items 
12.
    With objNewMail 
13.
        If .UnRead = True Then 
14.
            NumberOfMails = .Attachments.Count 
15.
            If NumberOfMails > 0 Then 
16.
                For i = 1 To NumberOfMails 
17.
                    .Attachments.Item(i).SaveAsFile Foldername & "\" & .Attachments.Item(i).FileName 
18.
                Next i 
19.
                colDelete.Add objNewMail 
20.
            End If 
21.
        End If 
22.
    End With 
23.
Next objNewMail 
24.
 
25.
For each mail in colDelete 
26.
  mail.Delete 
27.
Next 
28.
EndSub

Besser du verwendest aber diesen Code, da dieser noch mehr potentielle Fehlerquellen wie bereits vorhandene Attachments berücksichtigt:

Es verwendet das NewMailEx Ereignis das bei neuen Mails auftritt und der Funktion gleichzeitig alle eingetroffenen Mails mit deren ItemIDs mitteilt. Falls die Mail Anhänge besitzt werden diese in deinem gewünschten Verzeichnis abgelegt, und die Mail gelöscht. Zusätzlich wird überprüft ob bereits ein Anhang mit dem selben Namen in dem Ordner vorhanden ist, und in diesem Fall eine Nummer angehängt.
01.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) 
02.
    On Error Resume Next 
03.
    Dim objItem As MailItem, objProperty As UserProperty, arrEntryIDs As Variant, i As Integer, fso As Object, strFolder As String, _ 
04.
    att As Attachment, strPath As String 
05.
    Set fso = CreateObject("Scripting.FilesystemObject") 
06.
     
07.
    strFolder = "C:\temp" 
08.
    If Not fso.FolderExists(strFolder) Then 
09.
        MkDir strFolder 
10.
    End If 
11.
     
12.
    arrEntryIDs = Split(EntryIDCollection, ",") 
13.
 
14.
    For i = 0 To UBound(arrEntryIDs) 
15.
        Set objItem = Application.Session.GetItemFromID(arrEntryIDs(i)) 
16.
        If objItem.Class = olMail Then 
17.
            If objItem.Attachments.Count > 0 Then 
18.
                For Each att In objItem.Attachments 
19.
                    strPath = strFolder & "\" & att.FileName 
20.
                    counter = 1 
21.
                    While fso.FileExists(strPath) 
22.
                        strPath = strFolder & "\" & fso.GetBaseName(att.FileName) & "(" & counter & ")." & fso.GetExtensionName(att.FileName) 
23.
                        counter = counter + 1 
24.
                    Wend 
25.
                    att.SaveAsFile strPath 
26.
                Next 
27.
                objItem.Delete 
28.
            End If 
29.
        End If 
30.
    Next 
31.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: Paul1896
05.09.2014 um 08:10 Uhr
Hallo Uwe,

wow, vielen Dank für deine ausführliche Erläuterung und gute Darstellung . Hat mir schon sehr geholfen und vielen Dank für den Code.

Jetzt nochmal eine allgemene Verständnisfrage; dein geschriebenes Script füge ich nun in ThisOutlookSession ein und es sollte automatisch loslaufen, wenn?. Wenn ich es manuell anstarte, möchte er es als Makro speichern. Also mit dem VB-Editor von Microsoft stehe ich auf Kriegsfuß.

Wäre super, wenn du mir das nochmal erklären könntest.

Vielen, vielen dank für deine Antworten!
Bitte warten ..
Mitglied: colinardo
05.09.2014, aktualisiert um 08:39 Uhr
Jetzt nochmal eine allgemene Verständnisfrage; dein geschriebenes Script füge ich nun in ThisOutlookSession ein und es sollte automatisch loslaufen, wenn?
Genau dort fügst du es ein. Es ist ein Application-Event und startet immer dann automatisch wenn mindestens eine neue Mail in Outlook eingeht ! Daher auch der Name Application_NewMailEx.
Es bearbeitet also automatisch nur diese neu eingehenden Mails, keine bereits im Posteingang vorhandenen.
Bitte warten ..
Mitglied: Paul1896
05.09.2014 um 09:18 Uhr
Ah, supi danke. Kann ich dem Script auch vorgaukeln, wenn ich ungelesene Mails aus einem anderen Ordner ins Postfach schiebe, oder ist das Script so schlau und merkt das die nicht wirklich neu sind?
Bitte warten ..
Mitglied: colinardo
05.09.2014 um 09:28 Uhr
Zitat von Paul1896:

Ah, supi danke. Kann ich dem Script auch vorgaukeln, wenn ich ungelesene Mails aus einem anderen Ordner ins Postfach schiebe, oder
ist das Script so schlau und merkt das die nicht wirklich neu sind?

Das ist ein Application Event das bei allen neu eingehenden Mails für jedes eingerichtete Konto in Outlook ausgeführt wird. Das manuelle verschieben von einer Mail in ein Postfach gehört meines Erachtens nicht dazu, kann es aber gerade nicht 100% bestätigen, teste es einfach selber.
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Outlook & Mail
Outlook 2010 Mails im Entwürfeordner sind als "gesendet" markiert

Frage von staybb zum Thema Outlook & Mail ...

Vmware
ESXi automatisch starten möglich? (2)

Frage von Stefan007 zum Thema Vmware ...

Microsoft Office
Outlook Kalender Serientermin automatisch kategorie zuweisen (1)

Frage von DO1TJG zum Thema Microsoft Office ...

Exchange Server
gelöst W2011sbs - Exchange - gelöschte Mails automatisch löschen (8)

Frage von MG-One zum Thema Exchange Server ...

Heiß diskutierte Inhalte
Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...

Exchange Server
DNS Einstellung - zwei feste IPs für Mailserver (15)

Frage von ivan0s zum Thema Exchange Server ...