Markierter Mail Kat. zuweisen

Hallo,
ich habe untenstehenden Code um eine E-Mail zu erstellen als Antwort.
Nun möchte ich die markierte E-Mail im Outlook, auf die ich auch antworte, einer Kategorie zuordnen.
Ich habe in der Recherche bereits den .Categories = "Name" Code gefunden allerdings markiert dieses nur die Mail die ich als reply aus Excel erstelle (Entwurf bzw. gesendete Nachricht).
Kann mir jemand helfen und mir sagen welchen Code ich nehmen muss bzw. wo dieser stehen sollte damit ich die markierte E-Mail im Outlook zuordnen kann?
Als nächsten Punkt würde ich die markierte Mail auch gerne als "erledigt" (grüner Haken) in Outlook markieren, ist dies auch per VBA möglich?

LineReplyMail:
    
    ''_______________Send REPLY MAIL WITH SIGNATURE______________
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    
    On Error GoTo LineKeineMail
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1)
    '~~> Get MailItem.GetConversation method (Outlook)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getconversation
    Dim OutlookConversation As Object
    Set OutlookConversation = OutlookMail.GetConversation
    On Error GoTo LineKeineMail
    '~~> Conversation.GetTable method (Outlook)
' https://learn.microsoft.com/en-us/office/vba/api/outlook.conversation.gettable
    Dim OutlookTable As Object
    Set OutlookTable = OutlookConversation.GetTable
    
    On Error GoTo LineKeineMail
    '~~> Obtains a 2D array from the Table.
' https://learn.microsoft.com/en-us/office/vba/api/outlook.table.getarray
    Dim OutlookAr As Variant
    OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount)
    
    On Error GoTo LineKeineMail
    Dim OutlookReplyToThisMail As Object
    Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0))
    On Error GoTo LineKeineMail
    With OutlookReplyToThisMail.Reply
        .Categories = "Name"
        .SentOnBehalfOfName = "meine@emailadresse.de"
        .To = sKMail
        .CC = sAEMail
        .BodyFormat = 2
        .HTMLBody = sText & .HTMLBody
        .Display
    End With
    
    GoTo LineCreateTimestamp
    ''^^^^^^^^^_______________Send REPLY MAIL WITH SIGNATURE______________^^^^^^^^^

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Einzel_Rekl_Mail_reservieren() Dim myOlExp As Outlook.Explorer Dim myOlSel As Outlook.Selection Dim myaccount As store Set myaccount = Application.GetNamespace("MAPI").DefaultStore Set myOlExp = ActiveExplorer Set myOlSel = myOlExp.Selection With myOlSel.Item(1) .FlagStatus = olFlagMarked .FlagIcon = 5 .Categories =myaccount.DisplayName .Save End With End Sub

'_______________Send REPLY MAIL WITH SIGNATURE______________ Dim OutlookApp As Object Dim OutlookMail As Object On Error GoTo LineKeineMail Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1) OutlookMail.Categories = sUserSetFlag 'schreibt mir vorher den User aus M365 in eine variable und benennt diesen so um das es der Kategorie entspricht OutlookMail.FlagStatus = 1 OutlookMail.Save On Error GoTo LineKeineMail '~~> Get MailItem.GetConversation method (Outlook) ' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getconversation Dim OutlookConversation As Object Set OutlookConversation = OutlookMail.GetConversation

'-- Send Email >-- LineReplyMail: ''_______________Send REPLY MAIL WITH SIGNATURE______________ Dim OutlookApp As Object Dim OutlookMail As Object Dim EML As MailItem Dim Tx As String On Error GoTo LineKeineMail Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1) '~~> Get MailItem.GetConversation method (Outlook) ' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getconversation Dim OutlookConversation As Object Set OutlookConversation = OutlookMail.GetConversation On Error GoTo LineKeineMail '~~> Conversation.GetTable method (Outlook) ' https://learn.microsoft.com/en-us/office/vba/api/outlook.conversation.gettable Dim OutlookTable As Object Set OutlookTable = OutlookConversation.GetTable On Error GoTo LineKeineMail '~~> Obtains a 2D array from the Table. ' https://learn.microsoft.com/en-us/office/vba/api/outlook.table.getarray Dim OutlookAr As Variant OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount) On Error GoTo LineKeineMail Dim OutlookReplyToThisMail As Object Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0)) Set EML = ActiveExplorer.Selection(1) Tx = "Name" EML.Categories = Tx On Error GoTo LineKeineMail With OutlookReplyToThisMail.Reply .SentOnBehalfOfName = "meine@emailadresse.de" .To = sKMail .CC = sAEMail .BodyFormat = 2 .HTMLBody = sText & .HTMLBody .Display End With GoTo LineCreateTimestamp ''^^^^^^^^^_______________Send REPLY MAIL WITH SIGNATURE______________^^^^^^^^^

Dim aWD As Word.Application, Doc As Word.Document, Bkmrk As Word.Bookmark Set Doc = EML.GetInspector.WordEditor Set aWD = Doc.Application 'Remove Signature If Doc.Bookmarks.Exists("_MailAutoSig") Then Set Bkmrk = Doc.Bookmarks("_MailAutoSig") If Not Bkmrk Is Nothing Then Bkmrk.Select Doc.Windows(1).Selection.Delete End If End If

Sub Signature_setzen() Dim EML As MailItem Dim aWD As Word.Application, Doc As Word.Document, Bkmrk As Word.Bookmark Set EML = CreateItem(olMailItem) EML.BodyFormat = olFormatHTML EML.Display Set Doc = EML.GetInspector.WordEditor Set aWD = Doc.Application 'Add or Replace Signature If Doc.Bookmarks.Exists("_MailAutoSig") Then Set Bkmrk = Doc.Bookmarks("_MailAutoSig") Bkmrk.Range.Text = "qwe" End If End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread