Получение адреса пользователя добавленного в календарь

Public Sub AcceptMeeting(ActiveFolder, Inbox As String)
    'Parameter: Postfach / Ordner im Postfach
 
    Dim myNamespace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder
 
    Dim Subfolder As Outlook.Folder
    Dim Folder As Outlook.Folder
    Dim Change As Outlook.Folder
 
    Dim Item As Object
    Dim myAppt As Outlook.AppointmentItem
    Dim myMtg As Outlook.MeetingItem
 
    Dim counter As Integer
    counter = 0
 
    Dim Forward As Outlook.MeetingItem
 
    Dim Accept As Boolean
 
  
    Set myNamespace = Application.GetNamespace("MAPI")
 
    Set myFolder = myNamespace.Folders(ActiveFolder)
    Set Folders = myFolder.Folders
 
    Set Subfolder = Folders.Item(Inbox)
 
    For Each Item In Subfolder.Items
        DoEvents
    
        Accept = False
    
        If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then
 
            If ActiveFolder = "Application Management Linux1, I351" Then
                Accept = True
            End If
    
            If InStr(1, LCase(Item.Subject), "change") > 0 And Item.UnRead = True And Accept = True Then
                If InStr(1, LCase(Item.Subject), "produktion") > 0 Then
                    Item.Categories = "Change Produktion" 'Kategorie setzen PROD
                ElseIf InStr(1, LCase(Item.Subject), "integration") > 0 Then
                    Item.Categories = "Change Integration" 'Kategorie setzen INT
                ElseIf InStr(1, LCase(Item.Subject), "test") > 0 Then
                    Item.Categories = "Change Integration" 'Kategorie setzen INT
                Else
                    Item.Categories = "Change Info" 'Kategorie setzen Info
                End If
            
            
                Set myAppt = Item.GetAssociatedAppointment(True)
                Set myMtg = myAppt.Respond(olResponseAccepted, True)
                
                Item.UnRead = False
            
                If ActiveFolder = "Application Management Linux1, I351" Then
                    Set Change = myFolder.Folders("*** SPAM")
                    Set Forward = Item.Forward
                    Item.Move Change
                End If
                counter = counter + 1
            End If
        End If
    Next
 
    MsgBox Inbox & ": " & counter & " Meetings accepted", vbOKOnly, ActiveFolder 'Infofeld
    
End Sub