☰

MS Outlook 如何修改主题行（删除 RE:/FW 并添加前缀）

tag-icon • tag-icon vba microsoft-outlook-2010
MS Outlook 如何修改主题行（删除 RE:/FW 并添加前缀）

我想通过自动宏来更改收发电子邮件的主题行。

以下是我一直在寻找的内容：

  1. 一个宏，用于自动从收到的电子邮件中删除 RE:、Re:、FW:、Fw:。我尝试了下面的宏，但它不起作用。
  2. 根据收件人：行中的收件人电子邮件地址为新电子邮件或回复电子邮件添加前缀。

例如，如果电子邮件地址有 *@root.com，则添加前缀 Root Company -

宏：

Const CLASS_NAME = "SendAndReceive"

Private WithEvents olkApp As Outlook.Application
Private bolSend As Boolean, bolReceive As Boolean

Private Sub Class_Initialize()
    bolSend = True
    bolReceive = True
    Set olkApp = Outlook.Application
End Sub

Private Sub Class_Terminate()
    Set olkApp = Nothing
End Sub

Private Sub olkApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If (Left(Item.Subject, 4) = "FW: ") Or (Left(Item.Subject, 4) = "RE:") Then
        Item.Subject = Mid(Item.Subject, 5)
        Item.Save
    Else
        If Left(Item.Subject, 5) = "Fwd: " Then
            Item.Subject = Mid(Item.Subject, 6)
            Item.Save
        End If
    End If
End Sub

Private Sub olkApp_NewMailEx(ByVal EntryIDCollection As String)
    Dim arrEID As Variant, varEID As Variant, olkItm As Object
    arrEID = Split(EntryIDCollection, ",")
    For Each varEID In arrEID
        Set olkItm = Outlook.Session.GetItemFromID(varEID)
        If olkItm.Class = olMail Then
            Select Case Left(olkItm.Subject, 4)
                Case "FW: ", "RE: "
                    olkItm.Subject = Mid(olkItm.Subject, 5)
                    olkItm.Save
            End Select
        End If
    Next
    Set olkItm = Nothing
End Sub

Public Sub ToggleSend()
    bolSend = Not bolSend
    MsgBox "The process of removing RE: and FW: on sent messages has been turned " & IIf(bolSend, "'On'", "'Off'"), vbInformation + vbOKOnly, CLASS_NAME
End Sub

Public Sub ToggleReceive()
    bolReceive = Not bolReceive
    MsgBox "The process of removing 'RE:', 'FW:', and 'Fwd:'  on received messages has been turned " & IIf(bolReceive, "'On'", "'Off'"), vbInformation + vbOKOnly, CLASS_NAME
End Sub

答案1

可能你应该创建一个类模块。

使用内置类模块 ThisOutlookSession 更简单。它已设置为使用“应用程序”。

Const CLASS_NAME = "SendAndReceive"

Private bolSend As Boolean, bolReceive As Boolean

Private Sub application_startup()
    bolSend = True
    bolReceive = True
End Sub

Private Sub application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    ' Typo fixed here
    If (Left(Item.Subject, 4) = "FW: ") Or (Left(Item.Subject, 4) = "RE: ") Then
        Item.Subject = Mid(Item.Subject, 5)
        Item.Save
    Else
        If Left(Item.Subject, 5) = "Fwd: " Then
            Item.Subject = Mid(Item.Subject, 6)
            Item.Save
        End If
    End If
End Sub

Private Sub application_NewMailEx(ByVal EntryIDCollection As String)
    Dim arrEID As Variant, varEID As Variant, olkItm As Object
    arrEID = Split(EntryIDCollection, ",")
    For Each varEID In arrEID
        Set olkItm = Outlook.Session.GetItemFromID(varEID)
        If olkItm.Class = olMail Then
            Select Case Left(olkItm.Subject, 4)
                Case "FW: ", "RE: "
                Debug.Print olkItm.Subject
                    olkItm.Subject = Mid(olkItm.Subject, 5)
                    olkItm.Save
            End Select
        End If
    Next
    Set olkItm = Nothing
End Sub

Public Sub ToggleSend()
    bolSend = Not bolSend
    MsgBox "The process of removing RE: and FW: on sent messages has been turned " & IIf(bolSend, "'On'", "'Off'"), vbInformation + vbOKOnly, CLASS_NAME
End Sub

Public Sub ToggleReceive()
    bolReceive = Not bolReceive
    MsgBox "The process of removing 'RE:', 'FW:', and 'Fwd:'  on received messages has been turned " & IIf(bolReceive, "'On'", "'Off'"), vbInformation + vbOKOnly, CLASS_NAME
End Sub

相关内容