Item.Recipients for Task Assignment on Send

Status
Not open for further replies.

Zyzzx

New Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server
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")
 
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
 
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
 
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)
 
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.


Code:
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.
 
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.
 
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?
 
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
 
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
 
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)
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
C Persist all recipients on Item forward event Outlook VBA and Custom Forms 5
T Outlook365 search item listed as "potential matches" can't be opened Using Outlook 0
H Outlook 365 O365 outlook calendar item editing Using Outlook 1
P "Item could not be moved" message occurs frequently for IMAP inbox, Office 365 Using Outlook 0
V How to add 'Previous Item' and 'Next Item' to the Quick Access Toolbar Using Outlook 1
O In Agenda-view - How to copy an existing item months ahead or back? Using Outlook 0
S Outlook 2016 dont delete inbox item Using Outlook 0
talla Can't open Outlook Item. Using Outlook 0
N Item cannot be saved because it was modified by another user or window, and, Item could not be moved... Using Outlook 0
B Zoom automatically next email item (VBA) Outlook VBA and Custom Forms 2
S Command Button_Click action on Item/Reminder Outlook VBA and Custom Forms 3
A Unflag Inbox and Flag Inbox with Orange Category After Item is send Outlook VBA and Custom Forms 3
A Run-time error '430' on certain emails when trying to set "Outlook.mailitem" as "ActiveExplorer.Selection.Item" Outlook VBA and Custom Forms 2
C Copy Move item won't work Outlook VBA and Custom Forms 2
T Pictures degrade each time an Outlook item is edited and re-saved Using Outlook 1
B Change row background color of selected item Using Outlook 1
P Outlook 2013 "Item could not be moved - still an issue for Outlook 2013 Using Outlook 0
R Error when trying to forward current email item Outlook VBA and Custom Forms 7
geoffnoakes Find Contacts with UDFs "in this item" Using Outlook 1
T "cannot find the calendar folder for this item" - calendar items stuck in outbox Using Outlook 0
GregS Many Sent Item folders Using Outlook 3
B Select / activate first email item in the searched query Using Outlook 1
4 Macro to set the category of Deleted Item? Outlook VBA and Custom Forms 2
N "Discussion" item Using Outlook 3
T outlook.com opens with "item not found" Using Outlook 1
Peter H Williams How to Move Mail item after processing Outlook VBA and Custom Forms 5
C Change default "Save Sent Item To" folder Outlook VBA and Custom Forms 9
M Shortcut to another outlook item Using Outlook 0
M Item edits doesn't always sync Using Outlook 11
Cdub27 Your changes to this item couldn't be saved because Server Denied Operation (HTTP 403 Forbidden) Using Outlook 1
M VBA to change flag status in outlook contact item Outlook VBA and Custom Forms 3
P Replying to calendar item using VBA Outlook VBA and Custom Forms 4
G Outlook item link Using Outlook 0
Q VBA Script to move item in secondary mailbox Outlook VBA and Custom Forms 2
D Save Sent Item to Using Outlook 0
T outlook 2010 mail item count doesnt match display Outlook VBA and Custom Forms 3
Jeanne Goodman Delete Calendar Item Bypassing Deleted Items folder Outlook VBA and Custom Forms 2
Diane Poremsky Display the Created Date field of any Outlook item Using Outlook 0
Diane Poremsky Outlook VBA: Work with Open Item or Selected Item Using Outlook 0
M How does Outlook determine item numbers in a folder? Outlook VBA and Custom Forms 3
J "This item has been changed still want to delete it" message Using Outlook 3
oliv- HIDE ITEM Outlook VBA and Custom Forms 3
D help with Item/Inspector close event Outlook VBA and Custom Forms 1
T Create new item in public folder using VBscript Outlook VBA and Custom Forms 1
D Shared Mailbox with mail item marked as "private" Using Outlook 0
Diane Poremsky Change Item Count on All Folders in a Data File Using Outlook 0
M Recurring icon for custom form task item Outlook VBA and Custom Forms 6
N Adding Appointment Item in Outlook to Shared Calendar Folder Outlook VBA and Custom Forms 7
V Locate item Account Outlook VBA and Custom Forms 7
JohnP Shared Mailboxes "Save Sent Item" Using Outlook 2

Similar threads

Back
Top