Changing the subject line of a message to a set format

[RikH]

Can anyone help?
I'm trying to set up a script for Outlook 2003 to check the subject of any
new e-mail and amend it to a set format.
Although the script runs, and the msg boxes show up, the subject line isn't
updating:


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim intRes As Integer
Dim strMsg As String
Dim userName As String: userName = Environ("USERNAME")
Dim re As RegExp
Set re = New RegExp
re.Pattern = "(^.{0,4}Authorised:
20\d\d\d\d\d\d-.{2,100}-U$|^.{0,4}20\d\d\d\d\d\d-.{2,100}-\w{2,40}-[U|R]$)"
re.Global = False
re.IgnoreCase = True

If re.Test(Item.Subject) = False Then
re.Pattern = "(^.{0,4}Authorised:.*$)"
If re.Test(Item.Subject) = False Then
intRes = MsgBox("Is this message Authorised?", vbYesNo +
vbDefaultButton1 + vbExclamation, "Authorised")
If intRes = 6 Then
re.Pattern = "(.*-.*$)"
If re.Test(Item.Subject) = True Then
Item.Subject = "Authorised: " & Item.Subject
Else
Item.Subject = "Authorised: " & Format(Date, "yyyyMMdd") &
"-" & Item.Subject & "-" & userName & "-U"
End If
Else
strMsg = "Correct Formatting Options:" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "Authorised:
YYYYMMDD-Subject-UserName-U" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "OR" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) &
"YYYYMMDD-Subject-UserName-U or -R"
intRes = MsgBox(strMsg, vbOKOnly + vbDefaultButton1 +
vbExclamation, "Subject Line Incorectly Formatted")
re.Pattern = "(.*-.*$)"
If re.Test(Item.Subject) = False Then
Item.Subject = Format(Date, "yyyyMMdd") & "-" & Item.Subject
& "-" & userName & "-?"
End If
End If
Else
strMsg = "Correct Formatting Options:" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "Authorised
YYYYMMDD-Subject-UserName-U" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "OR" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "YYYYMMDD-Subject-UserName-U
or -R"
intRes = MsgBox(strMsg, vbOKOnly + vbDefaultButton1 + vbExclamation,
"Subject Line Incorectly Formatted")
End If
Cancel = True
End If
End Sub

 

[Ken Slovak - [MVP - Outlook]]

No change you make will persist unless you save the item.

 

[RikH]

Thanks Ken,

As a relative newbie to scripting, could you point me in the right direction
for saving the item please?

No change you make will persist unless you save the item.

Can anyone help?
I'm trying to set up a script for Outlook 2003 to check the subject of any
new e-mail and amend it to a set format.
Although the script runs, and the msg boxes show up, the subject line
isn't
updating:


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim intRes As Integer
Dim strMsg As String
Dim userName As String: userName = Environ("USERNAME")
Dim re As RegExp
Set re = New RegExp
re.Pattern = "(^.{0,4}Authorised:
20\d\d\d\d\d\d-.{2,100}-U$|^.{0,4}20\d\d\d\d\d\d-.{2,100}-\w{2,40}-[U|R]$)"
re.Global = False
re.IgnoreCase = True

If re.Test(Item.Subject) = False Then
re.Pattern = "(^.{0,4}Authorised:.*$)"
If re.Test(Item.Subject) = False Then
intRes = MsgBox("Is this message Authorised?", vbYesNo +
vbDefaultButton1 + vbExclamation, "Authorised")
If intRes = 6 Then
re.Pattern = "(.*-.*$)"
If re.Test(Item.Subject) = True Then
Item.Subject = "Authorised: " & Item.Subject
Else
Item.Subject = "Authorised: " & Format(Date, "yyyyMMdd") &
"-" & Item.Subject & "-" & userName & "-U"
End If
Else
strMsg = "Correct Formatting Options:" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "Authorised:
YYYYMMDD-Subject-UserName-U" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "OR" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) &
"YYYYMMDD-Subject-UserName-U or -R"
intRes = MsgBox(strMsg, vbOKOnly + vbDefaultButton1 +
vbExclamation, "Subject Line Incorectly Formatted")
re.Pattern = "(.*-.*$)"
If re.Test(Item.Subject) = False Then
Item.Subject = Format(Date, "yyyyMMdd") & "-" &
Item.Subject
& "-" & userName & "-?"
End If
End If
Else
strMsg = "Correct Formatting Options:" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "Authorised
YYYYMMDD-Subject-UserName-U" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "OR" & Chr(13) & Chr(10)
strMsg = strMsg & Chr(13) & Chr(10) & "YYYYMMDD-Subject-UserName-U
or -R"
intRes = MsgBox(strMsg, vbOKOnly + vbDefaultButton1 +
vbExclamation,
"Subject Line Incorectly Formatted")
End If
Cancel = True
End If
End Sub

 

[Ken Slovak - [MVP - Outlook]]

' start of the code

re.Pattern = "(.*-.*$)"
If re.Test(Item.Subject) = False Then
Item.Subject = Format(Date, "yyyyMMdd") & "-" & Item.Subject
& "-" & userName & "-?"
End If
End If

Item.Save
Else
strMsg = "Correct Formatting Options:" & Chr(13) & Chr(10)
'rest of the code