Outlook 宏在回复时删除和移动原始电子邮件 [英] Outlook macro to delete and move original email when replied to

问题描述

我正在尝试实现此代码，但它不起作用，请指教.我有 New Ticket 文件夹，一旦从 New Ticket 文件夹回复邮件，必须将邮件移动到 Completed 文件夹

I'm trying to implement this code but it's not working, Please advise. I've New Ticket folder, once replied from the New Ticket folder mails have to be moved to Completed folder

我正在寻找的代码，直接将所有回复的电子邮件移动到一个完整文件夹的宏.

Code I'm looking for, Macro that directly moves all the replied email to a completed folder.

在以下位置收到错误消息:olMail.Move olDestFolder ' move to InProgress 文件夹

Getting error message at : olMail.Move olDestFolder ' move to InProgress folder

我正在使用的代码:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = GetNamespace("MAPI")

Dim olDestFolder As Outlook.Folder
Set olDestFolder = olNameSpace.Folders("[e-mail]").Folders("In Progress")

Dim olLookUpFolder As Outlook.Folder
Set olLookUpFolder = olNameSpace.Folders("[e-mail]").Folders("Tickets")

Dim olMail As Outlook.MailItem

For Each olMail In olLookUpFolder.Items 'loop through Tickets folder to find original mail

    If InStr(1, olMail.Subject, strTicket) > 0 Then 'look for unique ticket Id

        olMail.Move olDestFolder ' move to InProgress folder

        Exit For

    End If

Next 

End Sub

推荐答案

从评论strTicket-阅读主题行并查看特定主题行是否作为响应".
您需要 strTicket = "text based on Item.Subject" for

From the comment "strTicket- to read the subject line and see if the particular subject line as a response".
You need strTicket = "text based on Item.Subject" for

If InStr(1, olMail.Subject, strTicket) > 0

例如:
Item.Subject Re:Ticket #123456"
strTicket 将是 123456.

For example:
Item.Subject "Re: Ticket #123456"
strTicket would be 123456.

If InStr(1, olMail.Subject, strTicket) > 0 Then 'look for unique ticket Id in olLookUpFolder.Items

无需提取唯一票证 ID.olMail.Subject 是唯一的，将在 Item.Subject 中.
如果 Item.Subject 是Re:Ticket #123456"
然后 olMail.Subject 是Ticket #123456"

There is no need to extract the unique ticket Id. olMail.Subject is unique and will be in Item.Subject.
If Item.Subject is "Re: Ticket #123456"
then olMail.Subject is "Ticket #123456"

反转 InStr 中搜索词的顺序.

Reverse the order of the search terms in InStr.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim olNameSpace As NameSpace
    Set olNameSpace = GetNamespace("MAPI")
    
    Dim olDestFolder As folder
    Set olDestFolder = olNameSpace.Folders("[e-mail]").Folders("In Progress")
    
    Dim olLookUpFolder As folder
    Set olLookUpFolder = olNameSpace.Folders("[e-mail]").Folders("Tickets")

    ' olMail is a Class. Avoid as a variable name
    'Dim olMail As MailItem
    Dim olObj As Object ' Outlook items are not necessarily mailitems
    
    For Each olObj In olLookUpFolder.Items 'loop through Tickets folder to find original mail
    
        If olObj.Class = olMail Then
            
            If InStr(1, Item.Subject, olObj.Subject) > 0 Then 'look for olObj.Subject in Item.Subject
                olObj.Move olDestFolder ' move to InProgress folder
                Exit For
            End If
            
        End If
    
    Next

End Sub

---

如果预览窗格已打开

---

If the preview pane is on then

错误:此方法不能用于内嵌响应邮件项."

Error: "This method can't be used with an inline response mail item."

此代码第一次重新启动 Outlook 并禁用 VBA.随后它只重新启动了 Outlook.如果您得到类似的结果，您可以决定自己关闭预览窗格，这样就不会调用预览窗格检查.

This code restarted Outlook and disabled VBA the first time. Subsequently it only restarted Outlook. If you get similar results you may decide to turn off the preview pane yourself so the preview pane check is not invoked.

If InStr(1, Item.Subject, olObj.Subject) > 0 Then 'look for olObj.Subject in Item.Subject
                                                    
    If ActiveExplorer.IsPaneVisible(olPreview) = True Then
                    
        ' Hide Preview Pane
        ' https://docs.microsoft.com/en-us/office/vba/api/outlook.explorer.ispanevisible
        ActiveExplorer.ShowPane olPreview, False
                    
        olObj.Move olDestFolder ' move to InProgress folder
                    
        ' Show Preview Pane
        ActiveExplorer.ShowPane olPreview, True
                    
    Else
                
        olObj.Move olDestFolder ' move to InProgress folder
                    
    End If
  
    Exit For
                
End If

有关与内联响应相关的错误的更多信息.

这篇关于Outlook 宏在回复时删除和移动原始电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！