Outlook Macro to move emails sends a copy to the delete folder

Question

I created a series of macros in Outlook to handle emails we receive from our support clients. Basically, there are 3 macros:

Called Incident that simply tags the email with my initials and paste the ticket number I created from the clipboard
Called Request that tags the email with my initials between brackets and move it to a folder named Requests
Called Update to requests that tags the email with the text $UPDATE TO REQUEST$ plus my initials: $UPDATE TO REQUEST$ (DR) -

All were working fine but since a few weeks, a copy is also sent to the delete folder and in some cases, it goes straight to that delete folder without a copy to the intended one.

The mailbox the macros work with is a IMAP mailbox we have in Outlook in addition to our personal mailbox using Exchange server. I don't understand why is doing that suddenly.

Option Explicit

Sub AddFileNumber()
    'add initials to the email header
    Dim myolApp As Outlook.Application
    Dim aItem As Object

    Set myolApp = CreateObject("Outlook.Application")
    Set aItem = myolApp.ActiveExplorer.Selection.Item(1)

    Dim iItemsUpdated As Integer
    Dim strTemp As String
    Dim strFilenum As Variant

    strFilenum = "(DR) - "
    If strFilenum = False Then Exit Sub
    If strFilenum = "" Then Exit Sub

    strTemp = "" & strFilenum & "" & aItem.Subject
    aItem.Subject = strTemp
    aItem.Save
End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
        Set GetCurrentItem = _
        objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
        Set GetCurrentItem = _
        objApp.ActiveInspector.CurrentItem
    Case Else
    End Select
End Function

Sub MasterMacro()
    'add the initials and move the email to the selected folder
    Call Request.AddFileNumber
    Call Request.MoveSelectedMessagesToFolder
End Sub

Option Explicit

Sub UpdateRequest()
    ' adds $UPDATE TO REQUEST$ and initials to the email header
    Dim myolApp As Outlook.Application
    Dim aItem As Object

    Set myolApp = CreateObject("Outlook.Application")
    Set aItem = myolApp.ActiveExplorer.Selection.Item(1)

    Dim iItemsUpdated As Integer
    Dim strTemp As String
    Dim strFilenum As Variant

    strFilenum = "$UPDATE TO REQUEST$ (DR) - "
    If strFilenum = False Then Exit Sub
    If strFilenum = "" Then Exit Sub

    strTemp = "" & strFilenum & "" & aItem.Subject
    aItem.Subject = strTemp
    aItem.Save
End Sub

Option Explicit

Sub MoveSelectedMessagesToFolder()

    On Error Resume Next
    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = objNS.Folders.Item("DOJ Helpdesk") _
        .Folders.Item("Inbox").Folders.Item("REQUESTS")

    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly _
            + vbExclamation, "INVALID FOLDER"
    End If

    If Application.ActiveExplorer.Selection.Count = 0 Then

        Exit Sub
    End If
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.Move objFolder
                objItem.UnRead = True
                objItem.Save
            End If
        End If
    Next

End Sub

Sub MasterUpdate()
    ' call both modules above
    Call Request.UpdateRequest
    Call Request.MoveSelectedMessagesToFolder
End Sub

Maybe there's nothing wrong with my code, but I want to make sure. — Manuel Isern
I cannot use rules for that mailbox and my macros are used by several support agents. — Manuel Isern
No hint of code to delete mail here. Put in a breakpoint and see if other code runs. — niton
We tried with another co-worker. In his Outlook, it creates copy and move it to the REQUESTS folder and keep the original tagged in the Inbox. Mine, instead of keeping a copy in the Inbox, it sends the original to the deleted folder. What it should do is to move the item to the REQUESTS folder without leaving a copy anywhere. — Manuel Isern
I notice you use On Error Resume Next without checking Err.Num. Used like this it means: "Don't bother telling me about any errors because I like obscure failure." — Tony Dallimore

Alina Li Alina Li · Accepted Answer · 2018-09-20T09:30:46

1.You could check your mail Rules and have a look whether rules been deleted or not.

2.You could check Outlook add-in and have a look whether email add-ins has been deleted.

3.You can switch account and check for same situation happened on other accounts.

Outlook Macro to move emails sends a copy to the delete folder

1 Answers