I have created a macro and attached it to a button in outlook. I want my CSRs to be able to press a button and receive any emails they should reply to and then be able to request additional emails to respond to. We do this by categorizing replies with the users name and moving them to a corresponding folder.
The macro should move over all already categorized emails and tell the person how many were moved and ask if they'd like additional. This is all working as expected, however, if the CSR requests additional emails I want it to pull the oldest non-categorized ones and it seems to be pulling the NEWEST emails instead. I have tried changing the sort from false to True with no luck. Any help is very much appreciated! I did try to change the names of the folders/inbox for anonymity.
Sub MoveAndCategorizeEmails()
' Declare variables
Dim olNamespace As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim olMSREmails As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim olItems As Outlook.Items
Dim olFolder As Outlook.MAPIFolder
Dim i As Integer
Dim movedCount As Integer
Dim additionalEmails As Integer
Dim userResponse As String
Dim categoryName As String
Dim additionalResponse As String
On Error GoTo ErrorHandler
' Set the category name (customize this for each user)
categoryName = "XXXXXX" ' Replace with your actual category name
' Get the namespace (MAPI) and the shared inbox folder
Set olNamespace = Application.GetNamespace("MAPI")
Set olInbox = olNamespace.Folders("CUSTOMERSERVICES").Folders("Inbox") ' Update this if the shared inbox name is different
Set olMSREmails = olNamespace.Folders("CUSTOMERSERVICES").Folders("CSR Emails") ' Ensure this folder exists
Set olItems = olInbox.Items
' Sort items by received date in ascending order (oldest first)
olItems.Sort "[ReceivedTime]", True
' Initialize counters
movedCount = 0
' Loop through the items in the inbox and move categorized emails
For i = olItems.Count To 1 Step -1
If TypeOf olItems(i) Is MailItem Then
Set olMail = olItems(i)
' Check if the email is categorized with the specified name
If olMail.Categories = categoryName Then
' Move the email to the corresponding folder
Set olFolder = olMSREmails.Folders(categoryName) ' Ensure a folder with the category name exists under "MSR Emails"
olMail.Move olFolder
movedCount = movedCount + 1
End If
End If
Next i
' Prompt the user for the number of additional emails to categorize and move
additionalResponse = InputBox("A total of " & movedCount & " emails were moved to your folder. How many additional emails do you want to categorize and move?", "Additional Email Request")
If Not IsNumeric(additionalResponse) Or additionalResponse <= 0 Then
MsgBox "Please enter a valid number."
Exit Sub
End If
additionalEmails = CInt(additionalResponse)
' Categorize and move additional emails if needed
If additionalEmails > 0 Then
Dim additionalMovedCount As Integer
additionalMovedCount = 0 ' Initialize counter for additional emails
For i = 1 To olItems.Count ' Loop from oldest to newest
If TypeOf olItems(i) Is MailItem Then
Set olMail = olItems(i)
' Check if the email is not categorized
If olMail.Categories = "" Then
' Categorize the email with the specified name
olMail.Categories = categoryName
' Move the email to the corresponding folder
Set olFolder = olMSREmails.Folders(categoryName) ' Ensure a folder with the category name exists under "MSR Emails"
olMail.Move olFolder
additionalMovedCount = additionalMovedCount + 1
' Exit the loop if the maximum number of additional emails is reached
If additionalMovedCount >= additionalEmails Then Exit For
End If
End If
Next i
End If
' Send a summary email
Dim olApp As Outlook.Application
Dim olNewMail As Outlook.MailItem
Set olApp = Outlook.Application
Set olNewMail = olApp.CreateItem(olMailItem)
With olNewMail
.To = "[email protected]"
.Subject = "Email Move Summary"
.Body = "I requested " & additionalEmails & " additional emails to be categorized and moved."
.Send
End With
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
olItemsafter the first loop, since you already removed some items from that collection.For i = 1 To olItems.Countyou typically don't want to loop forwards over a collection if you're going to be removing items from it, so maybe reverse the sort and loop backwards as you do in your first loop.