从传入邮件更改约会/邀请主题答案

【问题标题】：Change Appointment/Invite subject from incoming Mail从传入邮件更改约会/邀请主题
【发布时间】：2022-01-02 19:18:51
【问题描述】：

我制作了以下脚本来重命名收到的邮件作为 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 中也无法重命名邮件本身，但可以在日历中重命名约会。

如何从此处重命名与此邮件关联的约会？

【问题讨论】：

发布电子邮件和日历约会的图像。

标签： vba outlook

【解决方案1】：

邀请不是邮件。

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

【讨论】：

这成功重命名收件箱中的项目，但日历中的约会仍然是旧名称。

【解决方案2】：

我让它像这样工作：

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

【讨论】：