Top-Themen

Aktuelle Themen (A bis Z)

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

Frage Entwicklung VB for Applications

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

Mitglied: Paul1896

Paul1896 (Level 1) - Jetzt verbinden

04.09.2014 um 15:01 Uhr, 1378 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 ..
Ähnliche Inhalte
Outlook & Mail
Outlook Vorlage - automatisch E-Mail Signatur anhängen
Frage von gamerffOutlook & Mail3 Kommentare

Ich habe das Problem das wen ich eine Outlook Vorlage erstelle und bei einem Freund mit gleichem Outlook testen ...

Outlook & Mail
Outlook 2010 Regel funktioniert bei manueller Ausführung, nicht aber automatisch
Frage von edvintime.deOutlook & Mail1 Kommentar

Hey! Ich habe gerade bei einem Kunden eine Outlook-Regel angelegt, die Anhänge von Emails automatisch speichern soll. Die Regel ...

Microsoft
E-Mail PDF Anhang automatisch drucken
Frage von sven784230Microsoft7 Kommentare

Hallo zusammen, unsere Telefonanlage verschickt eingehende Fax-Nachrichten per Mail - das Fax selbst ist immer als PDF im Anhang. ...

VB for Applications
VBA Outlook - Automatisierte Anhänge - Script erweitern
gelöst Frage von sokraTonisVB for Applications3 Kommentare

Hallo Leute, ich würde mein Script: Sub AnlagenRewe(olMail As MailItem) Dim att As Attachment, fso As Object, ziel As ...

Neue Wissensbeiträge
Linux

Meltdown und Spectre: Linux Update

Information von Frank vor 16 StundenLinux

Meltdown (Variante 3 des Prozessorfehlers) Der Kernel 4.14.13 mit den Page-Table-Isolation-Code (PTI) ist nun für Fedora freigegeben worden. Er ...

Tipps & Tricks

Solutio Charly Updater Fehlermeldung: Das Abgleichen der Dateien in -Pfad- mit dem Datenobject ist fehlgeschlagen

Tipp von StefanKittel vor 1 TagTipps & Tricks

Hallo, hier einmal als Tipp für alle unter Euch die mit der Zahnarztabrechnungssoftware Charly von Solutio zu tun haben. ...

Sicherheit

Meltdown und Spectre: Wir brauchen eine "Abwrackprämie", die die CPU-Hersteller bezahlen

Information von Frank vor 1 TagSicherheit12 Kommentare

Zum aktuellen Thema Meltdown und Spectre: Ich wünsche mir von den CPU-Herstellern wie Intel, AMD oder ARM eine Art ...

Sicherheit

Meltdown und Spectre: Realitätscheck

Information von Frank vor 1 TagSicherheit9 Kommentare

Die unangenehme Realität Der Prozessorfehler mit seinen Varianten Meltdown und Spectre ist seit Juni 2017 bekannt. Trotzdem sind immer ...

Heiß diskutierte Inhalte
Sicherheit
Meltdown und Spectre: Die machen uns alle was vor
Information von FrankSicherheit25 Kommentare

Aktuell sieht es in den Medien so aus, als hätten die Hersteller wie Intel, Microsoft und Co den aktuellen ...

Netzwerke
Packet loss bei "InternetLeitungsvollauslastung"
gelöst Frage von Freak-On-SiliconNetzwerke17 Kommentare

Servus; Ja der Titel klingt komisch, is aber so. Wenn die Internetleitung voll ausgelastet ist, hab ich extreme packet ...

Ubuntu
Ubuntu - Starter für nicht vertrauenswürdige Anwendungen
Frage von adm2015Ubuntu17 Kommentare

Hallo zusammen, Ich verwende derzeit die Ubuntu Versionen 17.10 bzw. im Test 18.04. Ich habe mehrere .desktop Dateien in ...

Windows 10
Automatische daten kopieren, USB zu USB unter Win10 im Hintergrund
Frage von DerEisigeWindows 1016 Kommentare

Hallo Leute, ich bin auf der Suche nach einem Skript, dass von einem USB Stick automatisch nach dem einstecken ...