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