更改收到邮件的 Appointment/Invite 个主题

Change Appointment/Invite subject from incoming Mail

我制作了以下脚本来重命名 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

这适用于常规的传入邮件,但如果邮件是 Teams 会议的邀请,则不会更改主题。我怀疑这是因为在 outlook 中也无法重命名邮件本身,但可以在日历中重命名约会。

我如何从这里开始重命名与此邮件关联的约会?

邀请不是邮件。

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

我是这样工作的:

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