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

[Takasumi]

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.

Examples
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.

thanks

Code

' Adapted from code by Bryce Pepper (bpepper@kcsouthern.com)
' I found here http://en.kioskea.net/forum/affich-39527-outlook-macro-creating-folders
'
' 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: http://msdn.microsoft.com/en-us/library/aa155748(v=office.10).aspx
For count = objInboxFolder.Items.count To 1 Step -1
Call objInboxItems_ItemAdd(objInboxFolder.Items.Item(count))
Next count
StopRule
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)
Else
Set objProjectFolder = objDestinationFolder.Folders.Add(folderName)
End If
Item.Move objProjectFolder
Next
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
Next
FolderExists = False
End Function

 

[Diane Poremsky]

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
else
create folder
end if