MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Outlook (Express), sonst. Mailprogramme
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 30.01.2018, 10:12   #1
TT2G
Neuer Benutzer
Neuer Benutzer
Standard Frage - Move Done Mail mit VBA für Outlook dynamisch in Unterordner verschieben

Hallo zusammen,
ich verwende seit Jahren folgendes Makro (aus dem Forumthread https://goo.gl/r44Cnw) zum Verschieben von als 'Erledigt' markierten E-Mails in den Unterordner des jeweiligen Senders:
Code:

Sub MoveDoneMails()

    '-----------------------------------------------------------------------------------------
    ' Variablen deklarieren
    '-----------------------------------------------------------------------------------------
    Dim objSourceFolder         As Outlook.MAPIFolder       ' Zu bearbeitender Ordner
    Dim objMoveFolder           As Outlook.MAPIFolder       ' Ordner, in den verschoben wird
    Dim objMail                 As Outlook.MailItem         ' Einzelne Mail
    Dim objMails                As Outlook.Items            ' Alle Mails des Quellordners
     
    '-----------------------------------------------------------------------------------------
    ' E-Mail-Quellordner festlegen (Posteingang)
    '-----------------------------------------------------------------------------------------
    Set objSourceFolder = Outlook.Session.GetDefaultFolder(olFolderInbox)

   
    '-----------------------------------------------------------------------------------------
    ' E-Mails des E-Mail-Quellordner referenzieren
    '-----------------------------------------------------------------------------------------
    Set objMails = objSourceFolder.Items
   
    '-----------------------------------------------------------------------------------------
    ' E-Mail(s) verschieben
    '-----------------------------------------------------------------------------------------
    For Each objMail In objMails
       'MsgBox objMail.SenderName
   
    '-----------------------------------------------------------------------------------------
    ' E-Mail-Zielordner festlegen
    '-----------------------------------------------------------------------------------------
    If objMail.SenderName = "ABC" Or objMail.SenderName = "DEF"
Then
        Set objMoveFolder = objSourceFolder.Folders("Projektbeteiligte")
        Set objMoveFolder = objMoveFolder.Folders(objMail.SenderName)
            If objMail.Class = olMail Then
                If objMail.FlagStatus = olFlagComplete Then objMail.Move objMoveFolder
            End If

        Else
            Set objMoveFolder = objSourceFolder.Folders("_erledigt_Sammelordner")
            If objMail.Class = olMail Then
                If objMail.FlagStatus = olFlagComplete Then objMail.Move objMoveFolder
            End If
        End If
    Next
   
End Sub
Dieses Skript ist mittlerweile richtig lang und total unflexibel, da ich für jeden Sender einen eigenen Ordner mit seinem genauen Absendernamen erstellen und den Sender in die Liste eintragen muss und bei Änderung anpassen muss. Wird der Absender nicht in der Liste geführt, wird seine Mail in den Ordner '_erledigt Sammelordner'.

Was ich mir wünschen würde, aber wozu meine VB-Kenntnisse nicht hinreichen ist, für jeden Absender dynamisch den Absendernamen zu erkennen und ihm unter einem vorgegebenen Ordner (z.B. Projektbeteiligte) einen Ordner zu finden und wenn er nicht existiert, zu erstellen. Danach sollen alle als erledigt markierten E-Mails dieses Absenders dorthin verschoben werden. Suchordner sollen die Inbox und ein weiterer Ordner 'zurückgestellt' unter der Inbox sein.

Es wäre der Wahnsinn, wenn das realisiert werden würde.
Ich suche fast ebenso lange nach dieser Lösung, wie ich obigen Code schon nutze.

Vielen Dank im Voraus für Eure Unterstützung!

Geändert von TT2G (30.01.2018 um 10:18 Uhr).
TT2G ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.01.2018, 10:58   #2
EarlFred
MOF Guru
MOF Guru
Standard

Hallo,

ungetestet!
Code:

Option Explicit

Sub MoveDoneMails()
    
    Dim objSourceFolder         As Object
    Dim objMoveFolder           As Object       ' übergeordneter Ordner, in den verschoben wird
    Dim objMoveFolderTarget     As Object       ' Zielordner des Empfängers
    Dim objMail                 As Object
    Dim objMails                As Outlook.Items
     
    Set objSourceFolder = Outlook.Session.GetDefaultFolder(olFolderInbox)
    Set objMoveFolder = objSourceFolder.Folders("Projektbeteiligte")
    Set objMails = objSourceFolder.Items
    
    For Each objMail In objMails
      If objMail.Class = olMail Then
        If objMail.FlagStatus = olFlagComplete Then
          On Error Resume Next
          Set objMoveFolderTarget = objMoveFolder.Folders(objMail.SenderName)
          If Err Then Set objMoveFolderTarget = objMoveFolder.Folders.Add(objMail.SenderName, olFolderInbox)
          On Error GoTo 0
          objMail.Move objMoveFolderTarget
        End If
      End If
    Next
   
End Sub
Wenn der Code läuft und tut, was er soll, kannst Du den anderen Suchordner sicher selbst ergänzen.

Grüße
EarlFred

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 5 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,037% per 04.04.2018) - eine tolle Geste!
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.01.2018, 12:23   #3
mumpel
MOF Meister
MOF Meister
Standard

Hallo!

Noch eine Möglichkeit von mir.

Erstelle zuerst eine Textdatei. In dieser trägst Du die Absendernamen Semikolon-getrennt ein. Speichere die Textdatei in Deinem persönlichen Ordner ("Dokumente"). Nenne die Datei objektbeteiligte.

Option Explicit

Sub MoveDoneMails()

    Dim FSO                     As Object
    Dim TS                      As Object
    Dim DateiAuslesen           As String
    Dim olApp                   As Outlook.Application
    Dim olName                  As Outlook.Namespace
    Dim objSourceFolder         As Outlook.MAPIFolder
    Dim objMoveFolder           As Outlook.MAPIFolder
    Dim objMoveFolderTo         As Outlook.MAPIFolder
    Dim objMail                 As Outlook.MailItem
    Dim objMails                As Outlook.Items
    Dim vntBeteiligte           As Variant
    Dim lngBeteiligte           As Long
    Dim strBeteiligte           As String
 
    On Error Resume Next
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set TS = FSO.OpenTextFile(Environ("USERPROFILE") & "\Documents\objektbeteiligte.txt")
     DateiAuslesen = TS.ReadAll
     TS.Close
    On Error GoTo 0
 
    vntBeteiligte = Split(DateiAuslesen, ";")
      
    Set olApp = Application
    Set olName = olApp.GetNamespace("MAPI")
    Set objSourceFolder = olName.Session.Folders("René Holtz").Folders("Posteingang")
    Set objMails = objSourceFolder.Items
   
    On Error Resume Next
    For Each objMail In objMails
        If objMail.Class = olMail Then
           For lngBeteiligte = 0 To Ubound(vntBeteiligte)
               strBeteiligte = vntBeteiligte(lngBeteiligte)
               If objMail.SenderName = strBeteiligte Then
                  Set objMoveFolder = objSourceFolder.Folders("Projektbeteiligte")
                  Set objMoveFolderTo = objMoveFolder.Folders(strBeteiligte)
                  If Err Then Set objMoveFolderTo = objMoveFolder.Folders.Add(strBeteiligte)
                  If objMail.FlagStatus = olFlagComplete Then objMail.Move objMoveFolderTo
               Else
                  Set objMoveFolder = objSourceFolder.Folders("_erledigt_Sammelordner")
                  If objMail.FlagStatus = olFlagComplete Then objMail.Move objMoveFolder
               End If
           Next lngBeteiligte
        End If
    Next objMail
    
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0



Gruß, René

Geändert von mumpel (30.01.2018 um 12:40 Uhr).
mumpel ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.01.2018, 12:42   #4
mumpel
MOF Meister
MOF Meister
Standard

Nachtrag:
Natürlich noch die Ordnernamen anpassen.
mumpel ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.01.2018, 13:01   #5
EarlFred
MOF Guru
MOF Guru
Standard

@René,

deklariere mal objMail als Object. Damit vermeidest Du Fehler, wenn sich z. B. Einladungen im Posteingang befinden.
Nachfolgend gibt es im Code ja noch eine Prüfung auf
Code:

        If objMail.Class = olMail Then
Grüße
EarlFred

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 5 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,037% per 04.04.2018) - eine tolle Geste!
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 06.02.2018, 09:54   #6
TT2G
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Strahlen Der Wahnsinn!

Zitat: von EarlFred Beitrag anzeigen

Hallo,

ungetestet!

Code:

Option Explicit

Sub MoveDoneMails()
    
    Dim objSourceFolder         As Object
    Dim objMoveFolder           As Object       ' übergeordneter Ordner, in den verschoben wird
    Dim objMoveFolderTarget     As Object       ' Zielordner des Empfängers
    Dim objMail                 As Object
    Dim objMails                As Outlook.Items
     
    Set objSourceFolder = Outlook.Session.GetDefaultFolder(olFolderInbox)
    Set objMoveFolder = objSourceFolder.Folders("Projektbeteiligte")
    Set objMails = objSourceFolder.Items
    
    For Each objMail In objMails
      If objMail.Class = olMail Then
        If objMail.FlagStatus = olFlagComplete Then
          On Error Resume Next
          Set objMoveFolderTarget = objMoveFolder.Folders(objMail.SenderName)
          If Err Then Set objMoveFolderTarget = objMoveFolder.Folders.Add(objMail.SenderName, olFolderInbox)
          On Error GoTo 0
          objMail.Move objMoveFolderTarget
        End If
      End If
    Next
   
End Sub
Wenn der Code läuft und tut, was er soll, kannst Du den anderen Suchordner sicher selbst ergänzen.

Grüße
EarlFred

Hallo EarlFred,
der Code funktioniert auf Anhieb, wie ich mir das vorgestellt habe.
Vielen Dank!

Ich teste eben Renés Lösung und gebe dazu noch Feedback.
EDIT1: Renés Lösung ist auch schön, jedoch passt EarlFreds Lösung für meinen Anwendungsfall besser!
Vielen Dank Euch für diese Lösungen

VG Thomas

Geändert von TT2G (06.02.2018 um 10:48 Uhr). Grund: EDIT1
TT2G ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:01 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.