Messages no longer move to quote folder on shared mailbox after user adds -D to folder name

Not open for further replies.


Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
We have an Exchange based shared mailbox that 3 users full permissions have to administer.
The purpose of the mailbox is to manage quotes. How it works is they send out a sms quote request via email and replies come back. There is a macro that operates by clicking onse of two buttons, they check either the 'inbox' or 'sent items' for a quote number match and move the message to an inbox subfolder also containing the quote number. The macro check for existence of folder and create the folder if needed. The pattern length is set this way because the subject contains more information not required in folder creation. This way they can group messages pertaining to the same quote number without having to manually drag and drop, very handy.
When the users have finished that a quote they add -D to the folder name indicate completed. The problem arises when the quote has to be resent for whatever reason or there are late quote request replies, then the macro will no longer move the messages and does nothing. Asking the users to remove the -D each time is a hassle for them so wish to automate this. I am not fully understanding how the vba macro works and struggle to figure out how I might change it to also allow it recognise the destination folder name with a -D tagged on the end of it. Can anyone offer a solution or perhaps a different approach please? I have attached example and an extract of the macro that handles the Inbox, code is based on Bryce Pepper and modifications by Joel Slowik and myself.

What I am looking for is for the macro that will still identify the same quote folder with a -D tacked on the end of it.

Subject header: (macro looks in subject header for 5 digit number and records in a string up to including the date.)
LLNL Quote 10055 By 1500 Cart 07/05/14 Steers 450/500kg(10 Units Approx) 470 Ex 5518 Wedderburn-Becks Road Oturehua to 532 Ida Valley Road Oturehua 26Km Scan Anne

Destination folder name: (macro creates a string adding a 'Quote #' prefix then adding string above to check for or create the folder, I think)
Quote #10055 By 1500 Cart 07/05/14
Quote #10055 By 1500 Cart 07/05/14 -D

Tried not to be too long winded, keen to resolve and learn.



' Adapted from code by Bryce Pepper (
' I found here
' Searches for emails whose subject line contains a quote number (ex. 12345.00)
' and files them in a subfolder with the quote title (created if one does not exist)
' Date: Modified By: Modification Made:
' --------------------------------------------------------------------' 20110412 Joel Slowik Added support to iterate through emails in main Inbox folder
Dim WithEvents objInboxItems As Outlook.Items
Dim objDestinationFolder As Outlook.MAPIFolder
Sub Application_Startrule()
Dim objNameSpace As Outlook.NameSpace
Dim objInboxFolder As Outlook.MAPIFolder
Set objNameSpace = Application.Session
Set objInboxFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objDestinationFolder = objInboxFolder.Parent.Folders("Inbox")
'Due to how vb script collections work, start at the top and work our way down
'the list of emails:
For count = objInboxFolder.Items.count To 1 Step -1
Call objInboxItems_ItemAdd(objInboxFolder.Items.Item(count))
Next count
End Sub

' Run this code to stop your rule.
Sub StopRule()
Set objInboxItems = Nothing
End Sub
' This code is the actual rule.
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objProjectFolder As Outlook.MAPIFolder
Dim folderName As String
' Search for email subjects that contain a quote number
' Subject line must have the sequence of 5 numbers + . + 2 numbers (CPS quote number syntax)
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = False
objRegEx.Pattern = "[0-9]{5,5}.{23,23}"
Set colMatches = objRegEx.Execute(Item.Subject)
'For all matches, move those matches to respective folder (create folder if it does not exist)
If colMatches.count > 0 Then
For Each myMatch In colMatches
folderName = "Quote #" & myMatch.Value
If FolderExists(objDestinationFolder, folderName) Then
Set objProjectFolder = objDestinationFolder.Folders(folderName)
Set objProjectFolder = objDestinationFolder.Folders.Add(folderName)
End If
Item.Move objProjectFolder
End If
Set objProjectFolder = Nothing
End Sub

Function FolderExists(parentFolder As MAPIFolder, folderName As String)
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = False
objRegEx.Pattern = folderName
For Each F In parentFolder.Folders
Set colMatches = objRegEx.Execute(F.Name)
If colMatches.count > 0 Then
FolderExists = True
folderName = colMatches(0).Value
Exit Function
End If
FolderExists = False
End Function
Somewhere, maybe in this line, you need to trim the destination folder name using something like left(objDestinationFolder, 6)
If FolderExists(objDestinationFolder, folderName) Then

is the quote #/foldername always the same length? if so, you can use
If FolderExists(left(objDestinationFolder, 6), folderName) Then

where 6 is the length of the folder name, effectively trimming off the -D.
If it's not always the same length, I'd try a second if/testing for the name with a -d before trying to calculate the length of the folder and subtracting 3 to get the foldername.

something along the lines of this, where you check for the folder with and without the -D.
if folderexists(destination, foldername) or if folderexists(destination & " -D", foldername) then
' move
create folder
end if
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
S Related messages show in main Outlook window vice new Advanced Find windows Using Outlook 1
mrrobski68 Issue with Find messages in a conversation macro Outlook VBA and Custom Forms 1
N Reply to Outlook messages by moving messages to a specific Outlook folder Outlook VBA and Custom Forms 1
B Modify VBA to create a RULE to block multiple messages Outlook VBA and Custom Forms 0
G Question marks in messages Using Outlook 2
L How Stop Outlook Nag Messages Using Outlook 1
C Trying to move messages between imap accounts/folders Using Outlook 5
e_a_g_l_e_p_i Question about installing my Gmail account on my iPhone but still getting messages downloaded to my desktop Outlook. Using Outlook 3
P now on office 365 but getting error messages about missing Outlook 2013 cache folders Using Outlook 2
D Outlook 365 Forward Meeting Related Messages to Specific Meeting Organizer Outlook VBA and Custom Forms 0
V Macro to count flagged messages? Using Outlook 2
G Automatically delete messages in the synchronization folder Outlook VBA and Custom Forms 3
B IMAP server rejects sent email - cannot deliver messages Using Outlook 2
J Deliver new messages to New or Existing Data File? Using Outlook 2
M Messages Intermittently Dont Arrive In Sent Items After Sending Successfully Using Outlook 4
N Save selected messages VBA does not save replies and/or messages that contain : in subject Outlook VBA and Custom Forms 1
Travis Lloyd Messages Won't Display In Outlook 2019 Home & Business Using Outlook 0
M White square in body of Outlook Messages (O2016 Version 2012 32bit Click To Run) Using Outlook 4
R Why doesn't outlook use "Normal" style for new messages? Using Outlook 4
S Customize the autocolor font choices for replying/forwarding messages Outlook VBA and Custom Forms 2
B User defined field for messages with 'me' in the [To], [Cc] line Using Outlook 0
R Outlook Autoforward rule do not work for NDR messages Using Outlook 1
S Conditional Formatting for messages in a Conversation thread Using Outlook 1
GregS Outlook 2016 Sent Items vs Sent Messages Using Outlook 2
S Messages moved / deleted by auto-archive are not synchronized to exchange Exchange Server Administration 8
A Create date folder and move messages daily Outlook VBA and Custom Forms 1
ChrisK2 Send email to fails: "The group advertising isn't set up to receive messages from..." Using Outlook 3
J Outlook 2007 Hide Messages Option not Available Using Outlook 2
D Outlook 2016 customization of incoming messages Using Outlook 1
O Rule to move (specific) messages from Sent folder to Specific folder Using Outlook 1
V Outlook Macro to show Flagged messages Outlook VBA and Custom Forms 2
snissen Printing foreign language messages Using Outlook 1
S Receiving duplicate messages from RSS feeds Using Outlook 3
R Can't send messages to groups in Outlook Using Outlook 2
icacream outlook keeps neither SENT or FORWARDED messages... they vanish ! Using Outlook 4
B Looking to filter (or just find/search) for only messages that the sender has sent more than 1 messa Using Outlook 2
S Custom user fields in received messages Outlook VBA and Custom Forms 1
W Receiving messages in offline mode Outlook VBA and Custom Forms 1
RangerRick Text Extraction from forwarded messages external Exchange Server Administration 1
Bri the Tech Guy Run Script rule not running for newly arriving messages Outlook VBA and Custom Forms 25
L How to use different fonts for outgoing messages for different email accounts Using Outlook 0
A rule to flag messages not working Using Outlook 5
S Changing notification sound for new incoming messages in Outlook 365/2016 Using Outlook 1
T SMTP messages stuck in Outbox Using Outlook 0
Mark White VBA to deal with Recalled messages Outlook VBA and Custom Forms 7
F want inbox on toolbar to reference icloud messages Using Outlook 2
O Rules and Alerts for New Messages BEFORE sending Using Outlook 2
Liza Creating a rule in outlook to filter messages Using Outlook 0
S Automatically selecting folders and deleting messages in Outlook VBA Outlook VBA and Custom Forms 7
Diane Poremsky Save Messages and Attachments to a New Folder Using Outlook 0

Similar threads