Changing the subject line of a message to a set format

  • Thread starter Thread starter RikH
  • Start date Start date
R

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
 
Thanks Ken,

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

Ken Slovak - said:
No change you make will persist unless you save the item.




RikH said:
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
Click to expand...
Click to expand...
 
' 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
 
Back
Top