Checking .Subject for Dates and Formatting

[dts1234]

Hi everyone,

I have inherited some code which I have been ask to amend to include a new rule. The code performs a series of 'formatting' to selected email Subject lines. Eg, removing RE: FW:, removing. I'm unsure if I should use IsDate or Instr and how to construct the code. Any assistance would be greatly appreciated.

The rule is;

Check if subject starts with Date.
If the Date Format = YYYYMMDD, do not alter subject line, accept it and move to next if.
If the Date Format = DDMMYYY, replace with YYYYMMDD
and If no Date, add a backwards date YYYYMMDD at beginning of the email title string

The YYYYDDMM would be taken from .ReceivedTime of the mail.

*************

‘If TypeOf myItem Is Outlook.MailItem Then

' Format the date in the desired format
strDate = myItem.SentOn
If strDate = "" Then
strDate = "0"
Else
If strDate = "01/01/4501" Or strDate = "4501/01/01" Then
moddate = myItem.LastModificationTime
'mod2date = Format(moddate, "yymmdd") 'Date format of yyyymmdd - no time included - eg 20100527
'mod2date = Format(moddate, "yyyymmdd hhmm") 'Date format of yyyymmdd hhmm - includes hours and minutes - eg 20100527 1215
'mod2date = Format(moddate, "yymmmdd") 'Date format of yyyymmmdd - gives name of month - eg 2010May27
'mod2date = Format(moddate, "yymmdd") 'Date format of yyyymmdd - no time included - eg 20100527
strNewDate = mod2date & "-UNSENT"
Else
strNewDate = Format(strDate, "yyyymmdd") 'Date format of yyyymmdd - no time included - eg 20100527
'strNewDate = Format(strDate, "yyyymmdd hhmm") 'Date format of yyyymmdd hhmm - includes hours and minutes - eg 20100527 1215
'strNewDate = Format(strDate, "yyyymmmdd") 'Date format of yyyymmmdd - gives name of month - eg 2010May27
'strNewDate = Format(strDate, "yyyymmdd") 'Date format of yyyymmdd - no time included - eg 20100527

End If

End If

'Remove [SEC=*] from the Subject line, remove RE: and FW:, then trim to max 150 char subject line
strRawSubj = myItem.Subject
If strRawSubj = "" Then
 strRawSubj = "Receipt"
Else

 'Check if SEC in subject and remove if present
If Not InStr(strRawSubj, "[SEC=") = 0 Then
NumA = InStr(strRawSubj, "[SEC=") - 2
strNewSubj1 = Left(strRawSubj, NumA)
Else
strNewSubj1 = strRawSubj
End If

'Remove FW and RE prefixes
strNewSubj2 = Replace(strNewSubj1, "FW: ", "", , 1, vbTextCompare)
strNewSubj3 = Replace(strNewSubj2, "RE: ", "", , 1, vbTextCompare)

'Trim subject to 150 chars to be reasonable - should be plenty unless people are writing a book
strShortSubj = Left(strNewSubj3, 150)
End If

'Trim addressees to first comma so only first addressee recorded only if there is multiple addressees
strLongTo = myItem.To
If strLongTo = "" Then
strLongTo = "Recipient Unknown"
Else
If Not InStr(strLongTo, ";") = 0 Then
NumB = InStr(strLongTo, ";") - 1
strShortTo = Left(strLongTo, NumB)
Else
strShortTo = strLongTo

End If
End If

'Determine sender details
strSender = myItem.SentOnBehalfOfName 'use this line if you wish to use the mailbox name - comment out using the single quote ( ' ) if using the senders name
strSender = myItem.SenderName 'use this line if you wish to use the senders name - comment out using the single quote ( ' ) if using the mailbox name

If strSender = "" Then
strSender = "Sender Unknown"
End If

'New modified subject line to include addressee

strname = strNewDate & " - [" & strSender & "]-[" & strShortTo & "] " & strShortSubj
strname = strNewDate & " - " & strShortSubj

'FlagStatus - mark the items follow up flag as complete
'Test to ensure item is not a draft or unsent item
If InStr(strNewDate, "-UNSENT") = 0 Then
 myItem.FlagStatus = olFlagComplete
End If

 

[dts1234]

The more I read I think RegEx with a date pattern might be the way to go - if there's a date, remove it and then add ReceivedTime (YYYYMMDD) to the start of the .Subject line. Is that possible?