Verschieben von Outlook-Mails von einem bestimmten Absender in bestimmten Unterordner

[Niko]

Hallo an alle,
habe lange im Internet gesucht aber nirgendwo das gefunden was bei meinen Vorhaben passen könnte.
Habe bis jetzt diesen Code irgendwie zusammengebastelt (Copy/Paste system)…doch so ganz will es nicht klappen.
 
Was möchte ich bewerkstelligen?
Verschieben von Outlook-Mails von einem bestimmten Absender in einen bestimmten Unterordner über Excel
 
Beispiel-Datei: 
  MAILVerschieben_in_Ordner.xlsm (Größe: 18,52 KB / Downloads: 5)
Ich könnte Absendernamen aus dem Excel-Bereich (a2: a3) loopen,
aber ich kann Ordnernamen aus dem Excel-Bereich (b2: b3) nicht loopen,
um bestimmte Absender-Mails an einen bestimmten Ordner zu senden.
 
Hat jemand eine Idee, wie ich diesen Code vervollständigen kann? oder wenn eine Lösung vorhanden ist...ist sehr willkommen.


 
Danke im Voraus,
 

Niko

[Fennek]

Hallo,

Outlook bietet Regeln an, Mails für bestimmte Absender direkt nach Eingang zu verschieben. Da dies auch per VBA möglich ist, kann es auch für viele Absender installiert werden.

mfg

[Niko]

Hallo Fennek,

Danke für deinen Vorschlag, doch der ist mir bekannt und löst meine Aufgabe nicht.
Es geht um den VBA Code, wer da ein Lösungsvorschlag mir geben könnte ist willkommen.

[Fennek]

Aus der Datei:

Code:

python3 oledump.py /home/pi/Downloads/MAILVerschieben_in_Ordner.xlsm -s 3 -v
Attribute VB_Name = "Modul1"
Option Explicit


Sub MoveItems()
    Dim myNameSpace As Outlook.Namespace
    Dim myInbox As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Dim myItems As Outlook.Items
    Dim myItem As Object

    Set myNameSpace = Outlook.Application.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    'Set myDestFolder = myInbox.Folders("Meetings")
   
    Dim varSearchTerms As Variant
    varSearchTerms = Range("a2:a3").Value ' looped via excel range

    Dim varSearchTerm As Variant
    For Each varSearchTerm In varSearchTerms
    Set myDestFolder = myInbox.Folders(Range("b2:b3").Value)
    Set myItem = myItems.Find("[SenderName] = '" & varSearchTerm & "'")
        While TypeName(myItem) <> "Nothing"
            myItem.Move myDestFolder
            Set myItem = myItems.FindNext
        Wend
    Next
End Sub

1. Warum nicht zuerst Outlook definieren
    dim OL as Object: set OL = CreateObject("Outlook.Application")
2. Den Range("B2:B2") fest vorzugehen, ist ungeschickt
    Der SenderName aus Spalte A wird nicht übergeben, eigentlich wäre die Email-Adresse besser
3. Der "Find" Befehl muss auf "Items" nicht Item gesetzt werden

Da es nicht getestet werden kann, ist nur eine statische Analyse möglich

mfg

(Auf der Tastatur hackelt das "l" (klein L)

[Fennek]

Hallo,

erneut ungeprüft:

Genauso wie beim Löschen muss man vom letzten Item zum ersten verschieben.

Daher wäre der Vorschlag mit "Items.Restrict" zu arbeiten. Also Outlook-Makro wäre die Vorlage:

Code:

Sub Restrict_Items()
Dim FLD As Folder, Rstrct As Items
Dim sFilter As String

sFilter = "[SenderEmailAddress] = 'max.mustermann@web.de'"
Set FLD = ActiveExplorer.CurrentFolder

Set Rstrct = FLD.Items.Restrict(sFilter)

With Rstrct
    For i = .Count To 1 Step -1
    
        Debug.Print i, .Item(i).ReceivedTime, .Item(i).Subject
    Next i
End With
End Sub

mfg