Kategorie löschen. Mail zu Aufgabe

Moderator: ModerationP

Kategorie löschen. Mail zu Aufgabe

Beitragvon strommaus » 14. Feb 2019, 13:30

Hallo,
ich würde gerne das folgende Makro verbessern. Ich bekomme es nicht alleine hin. Vielleicht hat jemand einen Tipp. Vielen Dank!! :P

Das Makro erstellt aus Aufgaben Mails. Die Mail wird in der Aufgabe gespeichert mit einer Fälligkeit in zwei Tagen.

Ich würde jetzt noch gerne folgendes intergriere
- alle Kategorien der Mails sollen gelöscht werden, damit diese nicht in die Task übertragen wird.
- die Mail soll am Ende des Makros auch gelöscht werden

Sub Aufgabe_erzeugen()
'---------------------------------------------------------------------
'Aufgabe erzeugen: mit Kommentaren
'Beispiele für die Übernahme von Feldern aus der Mail in die Aufgabe.
'---------------------------------------------------------------------

Dim myNamespace As Outlook.NameSpace
Dim myItems As Outlook.Items
Dim myFolder As Outlook.Folder

Dim xMax As Long

Dim xMsg As Outlook.MailItem
Dim xTask As Outlook.TaskItem
Dim MailFrom As AddressEntry
Dim MailCC As AddressEntry
Set xMsg = ActiveExplorer.Selection.Item(1)
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Set xTask = myItems.Add("IPM.Task._new") 'spezielles Formular mit dem Namen "NameDesFormulars" aufrufen
'Set xTask = Application.CreateItem(olTaskItem) 'normales Aufgabenformular
Set MailFrom = xMsg.Recipients.Item(1).AddressEntry



With xTask
.Body = xMsg.Body
.Body = "Nachricht gesendet von: " & xMsg.SenderEmailAddress & vbCrLf & "Datum: " & xMsg.SentOn & vbCrLf & "_____________________________________________________________" & vbCrLf & vbCrLf & .Body ' & .Body auskommentieren, wenn kein Nachrichtext übergeben werden soll
.Attachments.Add xMsg 'Nachricht zusätzlich als Anhang wegen Anlagen

.Subject = xMsg.Subject 'Betreff übernehmen

'---------------------------------------------------------------------------------
'Es folgen weitere optionale Felder. Ggf. vorne das ' entfernen um zu aktivieren
'---------------------------------------------------------------------------------
'.Categories = xMsg.Categories 'Kategorien übernehmen
'.Recipients.Add xMsg.SenderEmailAddress 'Sender als Empfänger ergänzen
'.Status = olTaskInProgress ' Status bereits auf "in Bearbeitung" setzen
'.Importance = olImportanceHigh 'Wichtigkeit/Priorität immer auf "hoch" setzen
Select Case Weekday(Now, vbMonday)
'Fälligkeitsdatum in 2 Tagen (Mo-Fr) setzen
Case 4 To 5
.DueDate = Now + 4
Case Else
.DueDate = Now + 2
End Select
.Display
.Save


End With


End Sub



End Sub


Vielen Dank aus Frankfurt!
Eve
strommaus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4
Registriert: 14. Feb 2019, 13:14

Zurück zu Outlook Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast