M
Midwest Muskie
We are using Outlook 2007, SP1 with Exchange 2003, SP2.
We are using a form to route project opening orders for our company. There
are several users that are having the same problem with the form. The
troubleshooting I've done points to the Item_Send event not firing. I'm at
my wits end to try to figure out why the event doesn't fire on some machines.
I've checked macro security settings, and even re-installed Office. Here is
the code I'm using. Any help would be greatly appreciated.
Mike
Option Explicit
'
' Send only to the first person in the To field,
' Save other people in the To field into the RouteTo field.
'
Function Item_Send()
' Stop
Dim recipient
Dim i
Dim bDelete
Dim prpRouteTo
i = InStr(Item.To, ";")
If i Then
Set prpRouteTo = Item.UserProperties("RouteTo")
prpRouteTo.Value = Mid(Item.To, i + 1)
' if name "ProjectApproval isn't found on the routing list then add
it.
If InStr(UCase(prpRouteTo.Value), UCase("ProjectApproval")) = 0 Then
prpRouteTo.Value = prpRouteTo.Value & ";
(e-mail address removed)"
End If
bDelete = False
i = 1
While i <= Item.Recipients.Count
If Recipients.Item(i).Type = 1 Then ' olTo
If bDelete Then
Recipients.Item(i).Delete
Else
i = i + 1
bDelete = True
End If
Else
i = i + 1
End If
Wend
Else
Set prpRouteTo = Item.UserProperties("RouteTo")
' if name "ProjectApproval isn't found on the routing list then add
it.
If InStr(UCase(prpRouteTo.Value), UCase("ProjectApproval")) = 0 Then
prpRouteTo.Value = "(e-mail address removed)"
Else
prpRouteTo.Value = ""
End If
End If
' BCC to project approval unless the message is going To: that address.
If UCase(Item.To) <> UCase("(e-mail address removed)") Then
set recipient = Recipients.Add ("(e-mail address removed)")
recipient.Type = 3
' Item.cc = "(e-mail address removed)"
recipient.resolve
End If
End Function
'
' Route message to people in the RouteTo field
'
Function Item_CustomAction(ByVal Action, ByVal NewItem)
' Stop
Dim prpRouteTo
Dim i
Select Case Action.Name
Case "Route"
Set prpRouteTo = NewItem.UserProperties("RouteTo")
If prpRouteTo.Value <> "" Then
Item_CustomAction = True
NewItem.To = prpRouteTo.Value
prpRouteTo.Value = ""
Else
Item_CustomAction = False
End If
Case Else
Item_CustomAction = True
End Select
End Function
We are using a form to route project opening orders for our company. There
are several users that are having the same problem with the form. The
troubleshooting I've done points to the Item_Send event not firing. I'm at
my wits end to try to figure out why the event doesn't fire on some machines.
I've checked macro security settings, and even re-installed Office. Here is
the code I'm using. Any help would be greatly appreciated.
Mike
Option Explicit
'
' Send only to the first person in the To field,
' Save other people in the To field into the RouteTo field.
'
Function Item_Send()
' Stop
Dim recipient
Dim i
Dim bDelete
Dim prpRouteTo
i = InStr(Item.To, ";")
If i Then
Set prpRouteTo = Item.UserProperties("RouteTo")
prpRouteTo.Value = Mid(Item.To, i + 1)
' if name "ProjectApproval isn't found on the routing list then add
it.
If InStr(UCase(prpRouteTo.Value), UCase("ProjectApproval")) = 0 Then
prpRouteTo.Value = prpRouteTo.Value & ";
(e-mail address removed)"
End If
bDelete = False
i = 1
While i <= Item.Recipients.Count
If Recipients.Item(i).Type = 1 Then ' olTo
If bDelete Then
Recipients.Item(i).Delete
Else
i = i + 1
bDelete = True
End If
Else
i = i + 1
End If
Wend
Else
Set prpRouteTo = Item.UserProperties("RouteTo")
' if name "ProjectApproval isn't found on the routing list then add
it.
If InStr(UCase(prpRouteTo.Value), UCase("ProjectApproval")) = 0 Then
prpRouteTo.Value = "(e-mail address removed)"
Else
prpRouteTo.Value = ""
End If
End If
' BCC to project approval unless the message is going To: that address.
If UCase(Item.To) <> UCase("(e-mail address removed)") Then
set recipient = Recipients.Add ("(e-mail address removed)")
recipient.Type = 3
' Item.cc = "(e-mail address removed)"
recipient.resolve
End If
End Function
'
' Route message to people in the RouteTo field
'
Function Item_CustomAction(ByVal Action, ByVal NewItem)
' Stop
Dim prpRouteTo
Dim i
Select Case Action.Name
Case "Route"
Set prpRouteTo = NewItem.UserProperties("RouteTo")
If prpRouteTo.Value <> "" Then
Item_CustomAction = True
NewItem.To = prpRouteTo.Value
prpRouteTo.Value = ""
Else
Item_CustomAction = False
End If
Case Else
Item_CustomAction = True
End Select
End Function