Item.Recipients for Task Assignment on Send

[Zyzzx]

The following is the beginning of my VBA code, which has the core function to make sure the sender verifies that the information is not sensitive when sending emails to a recipient on from a list. I have built this from this forum and a few other forums. Currently, it works awesome for sending email; however, when I send a task with an assignee, it fails at "Set Recipients = Item.Recipients" (located 3rd line from the bottom) with a "Run-time error '438': Object doesn't support this property or method. In the end, I would like to get the recipients of all items, such as both mail and task items, so I can verify them before sending. I have sent appointment/meeting requests with no issues. Is this an achievable goal? I feel it should be. I hope this is enough information to get us started. I appreciate the help in advance.

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

Dim lbadFound As Boolean
Dim send As String
Dim Recipients, Recip, RecipList As String
Dim i As Integer
Dim aFile As String
Dim enviro As String
Dim n As Integer

enviro = CStr(VBA.Environ("USERPROFILE"))

aFile = enviro & "\AppData\Roaming\Microsoft\Outlook\MacroDebug.txt"

n = FreeFile()

Close #n

Set Recipients = Item.Recipients
Dim myNamespace As Outlook.NameSpace
Set myNamespace = Application.GetNamespace("MAPI")

 

[Diane Poremsky]

Can you post the full macro and i'll test it. It should work as long as you don't identify item as a mailitem or check fields a task request doesn't have.

 

[Zyzzx]

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

Dim lbadFound As Boolean
Dim send As String
Dim KaceCommands, Recipients, Recip, RecipList As String
Dim i As Integer
Dim aFile As String
Dim enviro As String
Dim n As Integer

enviro = CStr(VBA.Environ("USERPROFILE"))

aFile = enviro & "\AppData\Roaming\Microsoft\Outlook\MacroDebug.txt"

n = FreeFile()

Close #n

strTemp1 = "False"
Submit = ""
Priority = ""
Impact = ""
Status = ""
Submitter = ""
Owner = ""
Categories = ""
KaceCommands = ""
lbadFound = False

Set Recipients = Item.Recipients
Dim myNamespace As Outlook.NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
Sender = myNamespace.CurrentUser
EmailRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\EmailList"
ITRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\ITMembers"
TicketRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\TicketEmails"
EmailList = RegKeyRead(EmailRegKey)
ITList = RegKeyRead(ITRegKey)
TicketList = RegKeyRead(TicketRegKey)

For i = Recipients.Count To 1 Step -1
Recip = Recipients.Item(i)

RecipList = RecipList & " " & Recip

If InStr(VBA.LCase(ITList), VBA.LCase(Sender)) >= 1 And InStr(VBA.LCase(TicketList), VBA.LCase(Recip)) >= 1 Then
TicketSubmission.Show
End If

If InStr(VBA.LCase(TicketList), VBA.LCase(Recip)) >= 1 And InStr(Item.Body, "-+-+- Please reply above this line to add a comment -+-+-") = 0 Then
PriorityDialog.Show
Item.Body = "@priority=" & Priority & vbCrLf & Item.Body
End If

If InStr(VBA.LCase(EmailList), VBA.LCase(Recip)) >= 1 Then
lbadFound = True
Exit For
End If

Next i

If Impact <> "" Then
KaceCommands = KaceCommands & vbCrLf & "@impact=" & Impact
End If

If Status <> "" Then
KaceCommands = KaceCommands & vbCrLf & "@status=" & Status
End If

If Submitter <> "" Then
KaceCommands = KaceCommands & vbCrLf & "@submitter=" & Submitter
End If

If Owner <> "" Then
KaceCommands = KaceCommands & vbCrLf & "@owner=" & Owner
End If

If Categories <> "" Then
KaceCommands = KaceCommands & vbCrLf & "@category=" & Categories
End If

If KaceCommands <> "" Then
Item.Body = KaceCommands & vbCrLf & vbCrLf & Item.Body
End If

Open aFile For Output As #n
Print #n, "lbadFound = " & lbadFound & vbCrLf; "RecipList = " & RecipList & vbCrLf; "Sender = " & Sender
Close #n

If lbadFound Then
ExportComplianceCheck.DialogBox = "One or more of the recipients requires prior Export Compliance approval to receive technical data." & vbCrLf & vbCrLf & "Does this email contain unauthorized technical data?"
ExportComplianceCheck.Show
End If

If strTemp1 = True Then
Cancel = True
End If
End Sub

 

[Diane Poremsky]

You'll need to check if it's a task request and get the associated task time to get the recipient.

Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient

If Item.Class = olTaskRequest Then
Set mytaskreqItem = Item
Set myNewTaskItem = mytaskreqItem.GetAssociatedTask(True)
Debug.Print myNewTaskItem.Subject
Set recips = myNewTaskItem.Recipients
For Each recip In recips
Debug.Print recip
Next
End If

If Not Item.Class = olTaskRequest Then
'get the recipients
end if

 

[Zyzzx]

So...with the following sequence, I get the name of the recipient in the immediate window, but it fails at the last line, of what is pasted in this post, with "Run-time error '91': Object variable or With block variable not set" and I am not sure why. Will you assist, please?

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

Dim lbadFound As Boolean
Dim send As String
Dim KaceCommands, RecipList As String
Dim i As Integer
Dim aFile As String
Dim enviro As String
Dim n As Integer

enviro = CStr(VBA.Environ("USERPROFILE"))

aFile = enviro & "\AppData\Roaming\Microsoft\Outlook\MacroDebug.txt"

n = FreeFile()

Close #n

strTemp1 = "False"
Submit = ""
Priority = ""
Impact = ""
Status = ""
Submitter = ""
Owner = ""
Categories = ""
KaceCommands = ""
lbadFound = False

Dim Recips As Outlook.Recipients
Dim recip As Outlook.Recipient

If Item.Class = olTaskRequest Then
Set mytaskreqItem = Item
Set myNewTaskItem = mytaskreqItem.GetAssociatedTask(True)
Debug.Print myNewTaskItem.Subject
Set Recips = myNewTaskItem.Recips
For Each recip In Recips
Debug.Print recip
Next
End If

If Not Item.Class = olTaskRequest Then
Set Recips = Item.Recipients
For Each recip In Recips
Debug.Print recip
Next
End If

Dim myNamespace As Outlook.NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
Sender = myNamespace.CurrentUser
EmailRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\EmailList"
ITRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\ITMembers"
TicketRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\TicketEmails"
EmailList = RegKeyRead(EmailRegKey)
ITList = RegKeyRead(ITRegKey)
TicketList = RegKeyRead(TicketRegKey)

For i = Recips.Count To 1 Step -1
recip = Recips.Item(i)

 

[Diane Poremsky]

you'll need to put the code inside the if's, like this - i don't know if it's better to use for each or count*** - but task requests should only have one recipient, no need to loop. If would be nice if you could jump out and reuse those 3 if statements but at the moment my brain isn't seeing a way, short of putting them in a function.

If Item.Class = olTaskRequest Then
Set mytaskreqItem = Item
Set myNewTaskItem = mytaskreqItem.GetAssociatedTask(True)
Debug.Print myNewTaskItem.Subject
Set recips = myNewTaskItem.Recipients
For Each recip In recips

RecipList = RecipList & " " & Recip

If InStr(VBA.LCase(ITList), VBA.LCase(Sender)) >= 1 And InStr(VBA.LCase(TicketList), VBA.LCase(Recip)) >= 1 Then
TicketSubmission.Show
End If

If InStr(VBA.LCase(TicketList), VBA.LCase(Recip)) >= 1 And InStr(Item.Body, "-+-+- Please reply above this line to add a comment -+-+-") = 0 Then
PriorityDialog.Show
Item.Body = "@priority=" & Priority & vbCrLf & Item.Body
End If

If InStr(VBA.LCase(EmailList), VBA.LCase(Recip)) >= 1 Then
lbadFound = True
Exit For
End If


Next
End If

*** if you were deleting then you need to count backwards for sure.

 

[Diane Poremsky]

Of course, you'll repeat that for the Not Tasks loop - both loops would go after the Registry stuff, basically where those 3 if statements are now.

 

[Zyzzx]

I don't suppose you know of a way to simplify this:

If Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then
Set mytaskreqItem = Item
Set myNewTaskItem = mytaskreqItem.GetAssociatedTask(True)
Debug.Print myNewTaskItem.Subject
Set Recips = myNewTaskItem.Recipients
For Each recip In Recips
Debug.Print "TaskItem = "; recip
Next
End If

If Not Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then
Set Recips = Item.Recipients
For Each recip In Recips
Debug.Print "NonTaskItem = "; recip
Next
End If

Oh...also, I was able to keep these as is without putting the "For Each recip In recips" sequence in each one. It stores correctly. Do you know if I will run into issues going to the 2010 Outlook with this macro?

 

[Zyzzx]

Ugh...I have ran into another problem. I added a debug.print Item.Class and it shows " 51 " in the immediate window, without quotes. So, it starts and ends with a space. Oddly, it does go through the first if and second if. What could be wrong? I am getting stuck at the "Set Recips = Item.Recipients" in the second if statement.

If Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then
Debug.Print Item.Class
Set mytaskreqItem = Item
Set myNewTaskItem = mytaskreqItem.GetAssociatedTask(True)
Debug.Print myNewTaskItem.Subject
Set Recips = myNewTaskItem.Recipients
For Each recip In Recips
Debug.Print "TaskItem = "; recip
Next
End If

If Not Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then
Set Recips = Item.Recipients
For Each recip In Recips
Debug.Print "NonTaskItem = "; recip
Next
End If

 

[Diane Poremsky]

I don't suppose you know of a way to simplify this:

If Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then
Set mytaskreqItem = Item
Set myNewTaskItem = mytaskreqItem.GetAssociatedTask(True)
Debug.Print myNewTaskItem.Subject
Set Recips = myNewTaskItem.Recipients
For Each recip In Recips
Debug.Print "TaskItem = "; recip
Next
End If

If Not Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then
Set Recips = Item.Recipients
For Each recip In Recips
Debug.Print "NonTaskItem = "; recip
Next
End If

Oh...also, I was able to keep these as is without putting the "For Each recip In recips" sequence in each one. It stores correctly. Do you know if I will run into issues going to the 2010 Outlook with this macro?

It should be fine in 2010 - this is basic stuff and should work in all versions currently in use.


As for simplifying, it might not win any awards, but it works in a quickie test -
If Left(TypeName(Item), 4) = "Task" Then

If Not Left(TypeName(Item), 4) = "Task" Then

 

[Diane Poremsky]

If Not Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate Then

I think the problem here is NOT - you need one with each - although the double negative is more prone to fail. (B is not A and A is not B so "if not A or if not B" will get both A and B.)

This might work - but i like my simpler Typename.
If Not (Item.Class = olTaskRequest Or Item.Class = olTaskRequestAccept Or Item.Class = olTaskRequestDecline Or Item.Class = olTaskRequestUpdate) Then

or this
If Not Item.Class = olTaskRequest And Not Item.Class = olTaskRequestAccept And Not Item.Class = olTaskRequestDecline And Not Item.Class = olTaskRequestUpdate Then

(i didn't test either of those)