paul1896
Goto Top

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

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.

Private Sub Application_NewMail()
Dim Foldername As String
Dim objIn As MAPIFolder
Dim objNewMail As MailItem

On Error Resume Next
Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
For Each objNewMail In objIn.Items
    With objNewMail
        If .UnRead = True Then
            NumberOfMails = .Attachments.Count
            If NumberOfMails > 0 Then
                Foldername = "C:\temp\ "  
                MkDir Foldername
                For i = 1 To NumberOfMails
                    .Attachments.Item(i).SaveAsFile Foldername & "" _  
                                           & .Attachments.Item(i).FileName
                Next i
                objNewMail.Delete
            End If
        End If
    End With
Next objNewMail
EndSub

Content-Key: 248294

Url: https://administrator.de/contentid/248294

Ausgedruckt am: 28.03.2024 um 12:03 Uhr

Mitglied: colinardo
colinardo 04.09.2014 aktualisiert um 18:49:06 Uhr
Goto Top
Moin Paul1896,
in deinem Code sind einige Fehler drin, und wegen des On Error Resume Next bekommst du diese nicht angezeigt face-wink
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):
Private Sub Application_NewMail()
Dim Foldername As String, objIn As MAPIFolder, objNewMail As Object, fso as Object, colDelete as New Collection, mail as MailItem
Set fso = CreateObject("Scripting.FilesystemObject")  

Foldername = "C:\temp"  
If Not fso.FolderExists(Foldername) Then
  MkDir Foldername
End If

Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
For Each objNewMail In objIn.Items
    With objNewMail
        If .UnRead = True Then
            NumberOfMails = .Attachments.Count
            If NumberOfMails > 0 Then
                For i = 1 To NumberOfMails
                    .Attachments.Item(i).SaveAsFile Foldername & "\" & .Attachments.Item(i).FileName  
                Next i
                colDelete.Add objNewMail
            End If
        End If
    End With
Next objNewMail

For each mail in colDelete
  mail.Delete
Next
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.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    On Error Resume Next
    Dim objItem As MailItem, objProperty As UserProperty, arrEntryIDs As Variant, i As Integer, fso As Object, strFolder As String, _
    att As Attachment, strPath As String
    Set fso = CreateObject("Scripting.FilesystemObject")  
    
    strFolder = "C:\temp"  
    If Not fso.FolderExists(strFolder) Then
        MkDir strFolder
    End If
    
    arrEntryIDs = Split(EntryIDCollection, ",")  

    For i = 0 To UBound(arrEntryIDs)
        Set objItem = Application.Session.GetItemFromID(arrEntryIDs(i))
        If objItem.Class = olMail Then
            If objItem.Attachments.Count > 0 Then
                For Each att In objItem.Attachments
                    strPath = strFolder & "\" & att.FileName  
                    counter = 1
                    While fso.FileExists(strPath)
                        strPath = strFolder & "\" & fso.GetBaseName(att.FileName) & "(" & counter & ")." & fso.GetExtensionName(att.FileName)  
                        counter = counter + 1
                    Wend
                    att.SaveAsFile strPath
                Next
                objItem.Delete
            End If
        End If
    Next
End Sub
Grüße Uwe
Mitglied: Paul1896
Paul1896 05.09.2014 um 08:10:34 Uhr
Goto Top
Hallo Uwe,

wow, vielen Dank für deine ausführliche Erläuterung und gute Darstellung face-smile. 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!
Mitglied: colinardo
colinardo 05.09.2014 aktualisiert um 08:39:44 Uhr
Goto Top
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.
Mitglied: Paul1896
Paul1896 05.09.2014 um 09:18:09 Uhr
Goto Top
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?
Mitglied: colinardo
colinardo 05.09.2014 um 09:28:33 Uhr
Goto Top
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.