none
VBA: Setting Optional Attendee Does Not Always Take RRS feed

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

        sReqAttendee = "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 If

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

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

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

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

     

    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
    Moderator
  • 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.

     

    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