Home > Mobile >  Change Appointment/Invite subject from incoming Mail
Change Appointment/Invite subject from incoming Mail

Time:11-26

I made the following script to rename incoming mails as a rule in Outlook:

Sub RenameMails(MyMail As MailItem)
    Dim strID As String
    Dim objMail As Outlook.MailItem

    strID = MyMail.EntryID
    Set objMail = Application.Session.GetItemFromID(strID)
    If Left(objMail.Subject, 4) = "FW: " Then
        objMail.Subject = Right(objMail.Subject, Len(objMail.Subject) - 4)
        objMail.Subject = "Test: " & objMail.Subject
        objMail.Save
    End If

    Set objMail = Nothing
End Sub

This works for regular incoming mails, but if the mail is an invite to a Teams Meeting, it doesn't change the subject. I suspect it is because it's also not possible to rename the mail itself in outlook, but it is possible to rename the appointment in the calendar.

How do I go from here to renaming the appointment that is associated to this mail?

CodePudding user response:

An invite is not a mailitem.

Option Explicit

Sub RenameIncomingItems(myObj As Object)

    Debug.Print
    Debug.Print TypeName(myObj)
    
    If Left(myObj.subject, 4) = "FW: " Then
        myObj.subject = Right(myObj.subject, Len(myObj.subject) - 4)
        myObj.subject = "Test: " & myObj.subject
        myObj.Save
        Debug.Print " Subject saved: " & myObj.subject
    Else
        Debug.Print " FW: not found"
    End If

End Sub

Private Sub test()
    RenameIncomingItems ActiveInspector.CurrentItem
End Sub

CodePudding user response:

I made it work like this:

Sub RenameMails(objMail As Object)
    Dim myAppt As Outlook.AppointmentItem
    
    If (Left(objMail.Subject, 4) = "FW: ") Then
        objMail.Subject = Right(objMail.Subject, Len(objMail.Subject) - 4)
        objMail.Subject = "Test: " & objMail.Subject
        objMail.Save
    End If
    
    If (objMail.Class = olMeetingRequest) Then
        Set myAppt = objMail.GetAssociatedAppointment(True)
        
        If (Left(myAppt.Subject, 4) = "FW: ") Then
            myAppt.Subject = Right(myAppt.Subject, Len(myAppt.Subject) - 4)
            myAppt.Subject = "Test: " & myAppt.Subject
            myAppt.Save
        End If
    End If
End Sub
  • Related