Answered by:
VBA: Setting Optional Attendee Does Not Always Take

Question
-
I am trying to write VBA code to add attendees to a meeting. It seems to work some of the time, but most of the time, the optional attendees get changed back to Regular Attendees. Resource attendees always work (but I wonder if the recipient is flagged as a resource automatically). I can see the attendees be set as optional (in both the OptionalAttendee property and the Recipient.Type =2 in the subroutine where it is set. But when it goes back to the calling routine, often (I can't tell what the difference is when it works and not) it is reset, with the Type changing to 1, the OptionalAttendee list going to "", and the attendees that were supposed to be optional added to the RequiredAttendees list.
The calling routine contains code something like:
Dim olApt As Object
Dim olReqAttendee, olOptAttendee, olResAttendee As Outlook.Recipient
Dim sReqAttendee, sOptAttendee, sResAttendee As StringsReqAttendee = "John Smith; Jane Doe"
sOptAttendee = "Tom Jones; Johnny Quest"
Set olApt = olApp.CreateItem(olAppointmentItem)
OlApt.MeetingStatus = olMeeting 'identify as Meeting as opposed to Appointment
' All the other meeting items are set here also, removed for brevity sake
If Len(sReqAttendee) > 0 Then
AddAttendees olApt, sReqAttendee, olReqAttendee, olRequired
End If
If Len(sOptAttendee) > 0 Then
AddAttendees olApt, sOptAttendee, olOptAttendee, olCC ' have also tried olOptional
End If
If Len(sResAttendee) > 0 Then
AddAttendees olApt, sResAttendee, olResAttendee, olBCC 'have also used olResource
End IfThe function to Add Attendees is below:
Sub AddAttendees(olObj As Object, sAttendee As String, thisAttendee As Variant, Optional olType As Variant)
Dim arrRecipients As Variant
Dim i As Integer
Dim iLB, iUB As Integer
arrRecipients = SplitRecipients(sAttendee)
iLB = LBound(arrRecipients)
iUB = UBound(arrRecipients)
For i = iLB To iUB
Set thisAttendee = olObj.recipients.Add(arrRecipients(i))
If Not IsMissing(olType) Then thisAttendee.Type = olType
Next i
End SubThen the misc functions called are:
Function SplitRecipients(strRecipients As Variant, Optional iLB As Integer = 0) As String()
'Split string containing email addresses into array - break on either ',' or ';' or vbLF
Dim sTemp As String
Dim sArr() As String
Dim i, iUB As Integer
sTemp = Replace(strRecipients, ",", ";")
sTemp = Replace(sTemp, vbLf, ";")
sArr = Split(sTemp, ";")
iUB = UBound(sArr)
i = LBound(sArr)
While i <= iUB
sArr(i) = Trim(sArr(i))
If Len(sArr(i)) = 0 Then
DeleteFromArray sArr, i
iUB = iUB - 1
Else
i = i + 1
End If
Wend
SplitRecipients = sArr
End FunctionSub DeleteFromArray(arr As Variant, ByVal element As Long)
Dim li, newUB As Long
newUB = UBound(arr) - 1
For li = element To newUB
arr(li) = arr(li + 1)
Next li
ReDim Preserve arr(LBound(arr) To newUB)
End SubAny help would be greatly appreciated!
- Edited by Prostar 209 Wednesday, February 5, 2014 3:06 PM
Wednesday, February 5, 2014 12:36 AM
Answers
-
I have noticed the following code above:
For i = iLB To iUB Set thisAttendee = olObj.recipients.Add(arrRecipients(i)) If Not IsMissing(olType) Then thisAttendee.Type = olType Next i
I'd recommend breaking the chain of code into separate lines of code, for example:
Dim myRecipient As Outlook.Recipient Dim myRecipients As Outlook.Recipients Set myRecipients = olObj.recipients Set thisAttendee = myRecipients.Add(arrRecipients(i)) If Not IsMissing(olType) Then thisAttendee.Type = olType If Not myRecipients.ResolveAll Then For Each myRecipient In myRecipients If Not myRecipient.Resolved Then MsgBox myRecipient.Name End If Next End If
Did you try to use the ResolveAll method of the Recipients class to resolve all the Recipient objects in the Recipients collection against the Address Book.
Also you can try to Save the Appointment item right after modifying the Recipients collection.
- Edited by Eugene Astafiev Thursday, February 6, 2014 7:31 PM
- Marked as answer by Prostar 209 Thursday, February 6, 2014 9:09 PM
Thursday, February 6, 2014 7:31 PM
All replies
-
Hello Prostar,
Thank you for sharing the code. Note, you create an appointment object, not a meeting item.
To make a MeetingItem object available for the appointment object you need to set the MeetingStatus property, for example:
Sub CreateAppt() Dim myItem As Object Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient Set myItem = Application.CreateItem(olAppointmentItem) myItem.MeetingStatus = olMeeting myItem.Subject = "Strategy Meeting" myItem.Location = "Conference Room B" myItem.Start = #9/24/1997 1:30:00 PM# myItem.Duration = 90 Set myRequiredAttendee = myItem.Recipients.Add("Nate Sun") myRequiredAttendee.Type = olRequired Set myOptionalAttendee = myItem.Recipients.Add("Kevin Kennedy") myOptionalAttendee.Type = olOptional Set myResourceAttendee = myItem.Recipients.Add("Conference Room B") myResourceAttendee.Type = olResource myItem.Display End Sub
Wednesday, February 5, 2014 2:27 PM -
Eugene,
Thanks for the help. I did have it set as a meeting, I just left that out of my sample of the calling routine. I will see if I can update the original post to put that line in.
It does get created as a meeting. The Optional Attendees work sometimes, using the EXACT same input. The macro is called from an Excel spreadsheet that holds the meeting information. I can run the macro repeatedly, without changing the data, and get different results with regards to the Optional Attendees. Sometimes they hold as optional, but most of the time they revert back to required. For example, I just ran the routine twice, using the same data in the spreadsheet each time. There are 4 rows of data, each representing a meeting. Each time, only 1 of the 4 meetings correctly held on to the Optional Attendees. BUT, it was not the same meeting each time. The first time the 4th meeting was correct, the second time the 2nd meeting was correct. I am at a total loss.
Wednesday, February 5, 2014 3:01 PM -
Are you sure the code can run successfully?
I tried it but find it will not create a meeting item.
Thursday, February 6, 2014 10:50 AM -
Yes, the code runs fine. I did not post all of the original calling routine. It always creates the meetings, and as I said, it assigns the optional attendees sometimes (well, it always assigns them in the subroutine, visible in both the myAttendee object and the olItem object), but it often loses the optional designation when it exits the subroutine.
The full calling routine is:
Function CreateAppointments(Optional ByVal autoSend As Boolean = False) As Long Dim olApp As Object Dim olApt As Object Dim rCount As Long Dim rNum As Long Dim lAdd As Long Dim wsCurrent As Worksheet Dim dStart As Date Dim dEnd As Date Dim sSubject As String Dim sLocation As String Dim sBody As String Dim eBusyStatus As Integer Dim iReminder As Integer Dim bReminder As Boolean Dim sCategories As String On Error GoTo SubError ' Set olApp = New Outlook.Application Set olApp = CreateObject("Outlook.Application") Set wsCurrent = Sheets("Appointments") rCount = wsCurrent.Range("B1").Offset(wsCurrent.Rows.Count - 2, 0).End(xlUp).Row For rNum = 4 To rCount ' Set Reminder If wsCurrent.Range("e" & rNum).Value > 0 Then bReminder = True Else bReminder = False End If ' Set Busy flag If wsCurrent.Range("h" & rNum).Value = "Y" Then eBusyStatus = olBusy Else eBusyStatus = olFree End If ' Add category Event Reminder to Appnt so we can identify which events were created by this macro ' We will add to the other events entered in the spreadsheet. ' There will most likely be categories to work with Outlook macro to automatically send emails as reminders sCategories = "Event Reminder" If Len(wsCurrent.Range("i" & rNum).Value) > 0 Then sCategories = sCategories & ", " & wsCurrent.Range("i" & rNum).Value End If ' Create appointment bSuccess = SetApptMeeting(olApp, _ autoSend, _ wsCurrent.Range("b" & rNum).Value, _ wsCurrent.Range("c" & rNum).Value, _ wsCurrent.Range("d" & rNum).Value, _ wsCurrent.Range("e" & rNum).Value, _ IIf(wsCurrent.Range("e" & rNum).Value > 0, True, False), _ wsCurrent.Range("f" & rNum).Value, _ wsCurrent.Range("g" & rNum).Value, _ IIf(wsCurrent.Range("h" & rNum).Value = "Y", olBusy, olFree), _ sCategories, _ wsCurrent.Range("j" & rNum).Value) If bSuccess Then lAdd = lAdd + 1 Next rNum SubError: CreateAppointments = lAdd Set olApp = Nothing End Function
Thursday, February 6, 2014 11:29 AM -
Try saving the item after adding the recipients, does it help?
Ken Slovak MVP - Outlook
Thursday, February 6, 2014 2:59 PM -
I have noticed the following code above:
For i = iLB To iUB Set thisAttendee = olObj.recipients.Add(arrRecipients(i)) If Not IsMissing(olType) Then thisAttendee.Type = olType Next i
I'd recommend breaking the chain of code into separate lines of code, for example:
Dim myRecipient As Outlook.Recipient Dim myRecipients As Outlook.Recipients Set myRecipients = olObj.recipients Set thisAttendee = myRecipients.Add(arrRecipients(i)) If Not IsMissing(olType) Then thisAttendee.Type = olType If Not myRecipients.ResolveAll Then For Each myRecipient In myRecipients If Not myRecipient.Resolved Then MsgBox myRecipient.Name End If Next End If
Did you try to use the ResolveAll method of the Recipients class to resolve all the Recipient objects in the Recipients collection against the Address Book.
Also you can try to Save the Appointment item right after modifying the Recipients collection.
- Edited by Eugene Astafiev Thursday, February 6, 2014 7:31 PM
- Marked as answer by Prostar 209 Thursday, February 6, 2014 9:09 PM
Thursday, February 6, 2014 7:31 PM -
Eugene and Ken,
Thanks so much to both of you for your help. As it turns out, saving the meeting did not seem to help on its own, but adding the .Resolveall did. (I left in the save to be safe.) My final sub looks like this:
Sub AddAttendees(olObj As Object, sAttendee As String, thisAttendee As Variant, Optional olType As Variant) Dim arrRecipients As Variant Dim i As Integer Dim iLB, iUB As Integer On Error GoTo CleanUp: arrRecipients = SplitRecipients(sAttendee) iLB = LBound(arrRecipients) iUB = UBound(arrRecipients) For i = iLB To iUB Set thisAttendee = olObj.recipients.Add(arrRecipients(i)) If Not IsMissing(olType) Then thisAttendee.Type = olType End If Next i olObj.recipients.ResolveAll If (Not IsMissing(olType) And olType = olOptional) Then olObj.Save End If CleanUp: End Sub
I have run the routine multiple times now and it always seems to work as designed.
Thanks again for your help!
Thursday, February 6, 2014 9:20 PM