Outlook macro to delete and move original email when replied to

问题

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.

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

Code I'm using:

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("xxx@xxx.com").Folders("In Progress")

Dim olLookUpFolder As Outlook.Folder
Set olLookUpFolder = olNameSpace.Folders("xxx@xxx.com").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

回答1:

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

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

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"

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("xxx@xxx.com").Folders("In Progress")
    
    Dim olLookUpFolder As folder
    Set olLookUpFolder = olNameSpace.Folders("xxx@xxx.com").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."

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

More information about the error related to inline response.

来源：https://stackoverflow.com/questions/63639187/outlook-macro-to-delete-and-move-original-email-when-replied-to