2017-10-04 7 views
0

다른 참가자를 추가하여 보내기 전에 전체 참가자 수를 어떻게 계산합니까?Outlook에서 다른 사람을 추가하기 전에 회의 참가자를 어떻게 계산합니까?

특정 응답을 기반으로 캘린더 초대를 자동화 할 수있었습니다.

이제 최대 수의 참가자를 설정하고 해당 모임이나 이벤트의 최대 참가자 수에 도달 한 경우 메일로 응답해야합니다.

값을 확인하면 "1"로 유지되는 것 같습니다.

이것은 내가 도움을 청하지 않고 서둘 수 있었다.

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object) 


Dim objMeetingInvitation As Outlook.MeetingItem 
Dim objMeeting As Outlook.AppointmentItem 
Dim objAttendees As Outlook.Recipients 
Dim objAttendee As Outlook.Recipient 
Dim lRequiredAttendeeCount, lOptionalAttendeeCount, lResourceCount As Long 
Dim strMsg As String 
Dim nPrompt As Integer 


On Error Resume Next 

Dim olMailItem As MailItem 
Dim strAttachementName As String 
Dim oRespond As Outlook.MailItem 
Dim mesgBody As String 
Dim oApp As Outlook.Application 
Dim oCalFolder As Outlook.MAPIFolder 
Dim oAppt As Outlook.AppointmentItem 
Dim sOldText As String 
Dim sNewText As String 
Dim iCalChangedCount As Integer 
Dim mail As Outlook.MailItem 
Set oApp = Outlook.Application 
Dim nmSpace As Outlook.NameSpace 
Set nmSpace = oApp.GetNamespace("MAPI") 
Set oCalFolder = nmSpace.GetDefaultFolder(olFolderCalendar) 

     If TypeOf Item Is MailItem Then 

        Set olMailItem = Item 
        Set objMeetingInvitation = Item 
        Set objMeeting = objMeetingInvitation.GetAssociatedAppointment(True) 
        Set objAttendees = objMeetingInvitation.Recipients 

        lRequiredAttendeeCount = 0 
        lOptionalAttendeeCount = 0 
        lResourceCount = 0 

        'Count the required & optional attendees and resources, etc. 


        '=============================================================================================================== 
        ' Please note... 
        ' 
        ' I used mailto:[email protected]******.co.za?subject=Yes,%20please%20include%20me&body=I%20would%20like%20to%20join 
        ' as a "mailto:" response 
        ' 
        '=============================================================================================================== 


         If InStr(olMailItem.Subject, "Testing the Calendar") > 0 Then 
         sOldText = "Test Calendar" 

          For Each objAttendee In objAttendees 
           If objAttendee.Type = olRequired Then 
            lRequiredAttendeeCount = lRequiredAttendeeCount + 1 
           ElseIf objAttendee.Type = olOptional Then 
            lOptionalAttendeeCount = lOptionalAttendeeCount + 1 
           ElseIf objAttendee.Type = olResource Then 
            lResourceCount = lResourceCount + 1 
           End If 
          Next 

          If lRequiredAttendeeCount > 1 Then 
           MsgBox "Attendees on list too many :" & lRequiredAttendeeCount, vbOKOnly 
           Exit Sub 
          End If 

         Do 
          If Not (oCalFolder Is Nothing) Then 
           If (oCalFolder.DefaultItemType = olAppointmentItem) Then Exit Do 

          End If 



          'MsgBox ("Please select a calendar folder from the following list.") 
          'Set oCalFolder = GetDefaultFolder(olFolderCalendar) 
          On Error GoTo ErrHandler: 
           Loop Until oCalFolder.DefaultItemType = olAppointmentItem 
           ' Loop through appointments in calendar, change text where necessary, keep count 
           iCalChangedCount = 0 
          For Each oAppt In oCalFolder.Items 
           If InStr(oAppt.Subject, sOldText) <> 0 Then 
            Debug.Print "Changed: " & oAppt.Subject & " - " & oAppt.Start 
            oAppt.Recipients.Add (olMailItem.SenderEmailAddress) 
            'oAppt.Display 
            oAppt.Save 
            oAppt.Send 
            iCalChangedCount = iCalChangedCount + 1 
           End If 
          Next 
          ' Display results and clear table 
          MsgBox (iCalChangedCount & " appointments have been updated. You have " & lRequiredAttendeeCount & "attendees.") 

         Set oAppt = Nothing 
         Set oCalFolder = Nothing 
         Exit Sub 
         End If 


    ErrHandler: 
     MsgBox ("Macro terminated.") 



         End If 
        Set Item = Nothing 
        Set olMailItem = Nothing 

    End Sub 

나는이 가진 참가자를 계산 할 수있었습니다하지만 난 어떤 아이디어가 전혀 이해할 수있을 것이다 두 ...

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 
Dim objMeetingInvitation As Outlook.MeetingItem 
Dim objMeeting As Outlook.AppointmentItem 
Dim objAttendees As Outlook.Recipients 
Dim objAttendee As Outlook.Recipient 
Dim lRequiredAttendeeCount, lOptionalAttendeeCount, lResourceCount As Long 
Dim strMsg As String 
Dim nPrompt As Integer 

If TypeOf Item Is MeetingItem Then 
    Set objMeetingInvitation = Item 
    Set objMeeting = objMeetingInvitation.GetAssociatedAppointment(True) 
    Set objAttendees = objMeetingInvitation.Recipients 
End If 

lRequiredAttendeeCount = 0 
lOptionalAttendeeCount = 0 
lResourceCount = 0 

'Count the required & optional attendees and resources, etc. 
For Each objAttendee In objAttendees 
    If objAttendee.Type = olRequired Then 
     lRequiredAttendeeCount = lRequiredAttendeeCount + 1 
    ElseIf objAttendee.Type = olOptional Then 
     lOptionalAttendeeCount = lOptionalAttendeeCount + 1 
    ElseIf objAttendee.Type = olResource Then 
     lResourceCount = lResourceCount + 1 
    End If 
Next 



'Double check the meeting invitation details 
strMsg = "Meeting Details:" & vbCrLf & vbCrLf & _ 
"Required Attendees: " & lRequiredAttendeeCount & vbCrLf & _ 
"Optional Attendees: " & lOptionalAttendeeCount & vbCrLf & _ 
"Resources: " & lResourceCount & vbCrLf & _ 
"Duration: " & GetDuration(objMeeting) & vbCrLf & vbCrLf & _ 
"Are you sure to send this meeting invitation?" 

nPrompt = MsgBox(strMsg, vbExclamation + vbYesNo, "Double Check Meeting Invitation") 

If nPrompt = vbYes Then 
    Cancel = False 
Else 
    Cancel = True 
End If 


End Sub 

결합하려고 잃었어요!

답변

1

저는이 질문이 너무 광범위해서 적어도 세 가지 질문으로 나눌 수 있다고 생각합니다. 추가 및 전송 부분없이 "회의의 총 참가자 수는 어떻게 계산합니까?"에 초점을 맞 춥니 다.

응답이 도착하면 코드를 실행한다고 가정해야합니다.

Option Explicit 

Private Sub objNewMailItems_ItemAdd_Test() 
    ' first open up a response to a meeting invitation 
    objNewMailItems_ItemAdd ActiveInspector.currentItem 
End Sub 


Private Sub objNewMailItems_ItemAdd(ByVal Item As Object) 

Dim oAppt As AppointmentItem 

Dim objAttendees As Recipients 
Dim objAttendee As Recipient 

Dim lRequiredAttendeeCount As Long 
Dim lOptionalAttendeeCount As Long 
Dim lResourceCount As Long 

Dim possibleAttendees As Long 

Dim limitedAtendees As Long 

' For testing purposes 
limitedAtendees = InputBox(Prompt:="Enter the maximum number of invitations allowed", Default:="2") 

'limitedAtendees = some maximum 


' Kiss of death removed 
'On Error Resume Next 

If TypeOf Item Is MeetingItem Then 

    ' Bypass one error only, for a specific purpose 
    On Error Resume Next 
    Set oAppt = Item.GetAssociatedAppointment(True) 
    ' Turn off bypass 
    On Error GoTo 0 

    If oAppt Is Nothing Then 
     MsgBox "No associated appointment found." 
     Exit Sub 
    End If 

    Set objAttendees = oAppt.Recipients 
    'Debug.Print objAttendees.count 

    lRequiredAttendeeCount = 0 
    lOptionalAttendeeCount = 0 
    lResourceCount = 0 

    'Count the required & optional attendees and resources, etc. 

    For Each objAttendee In objAttendees 

     'Debug.Print objAttendee 

     If objAttendee.Type = olRequired Then 
      lRequiredAttendeeCount = lRequiredAttendeeCount + 1 
     'ElseIf objAttendee.Type = olOptional Then 
     ' lOptionalAttendeeCount = lOptionalAttendeeCount + 1 
     'ElseIf objAttendee.Type = olResource Then 
     ' lResourceCount = lResourceCount + 1 
     End If 

    Next 

    If lRequiredAttendeeCount > limitedAtendees Then 
     MsgBox "Invitations to Required Atendees: " & lRequiredAttendeeCount & vbCr & _ 
      "This is more than the limit of.......: " & limitedAtendees, vbOKOnly 
    Else 
     MsgBox "Invitations to Required Atendees: " & lRequiredAttendeeCount & vbCr & _ 
      "This is within the limit of...........: " & limitedAtendees, vbOKOnly 
    End If 

    If objAttendees.count > limitedAtendees Then 
     MsgBox "Invitations to All Atendees..: " & objAttendees.count & vbCr & _ 
      "This is more than the limit of: " & limitedAtendees, vbOKOnly 
    Else 
     MsgBox "Invitations to All Atendees: " & lRequiredAttendeeCount & vbCr & _ 
      "This is within the limit of....: " & limitedAtendees, vbOKOnly 
    End If 

End If 

ExitRoutine: 
    Set oAppt = Nothing 

End Sub 

편집 2,071,010

초대장의 수에 대한 질문 포인트의 코드 그러나 당신이 응답의 수를 필요로 나타납니다.

Private Sub objNewMailItems_ItemAdd(ByVal Item As Object) 

Dim objAppt As AppointmentItem 
Dim objAttendee As Recipient 

Dim lOrganizerAttendeeCount As Long 
Dim lRequiredAttendeeCount As Long 
Dim lOptionalAttendeeCount As Long 
Dim lResourceCount As Long 

Dim attendeeOrganizerNoneCount As Long 
Dim attendeeAcceptedCount As Long 
Dim attendeeTentativeCount As Long 
Dim attendeeDeclinedCount As Long 
Dim attendeeNotRespondedCount As Long 

Dim invitedAttendees As Long 
Dim respondingAttendees As Long 

Dim uPrompt As String 
Dim uTitle As String 

Debug.Print 
Debug.Print "Item.Class: " & Item.Class 

' 26 - AppointmentItem 
' 
' Various MeetingItems 
' 53 to 57 
' 53 - should be the initial invitation 
' 181 - Meeting Forward Notification 
' - with no response (0), the invited person counts as a "None" response 

If Item.Class = 26 Then 
    Set objAppt = Item 

' tested 
' olMeetingResponsePositive 
' 53 
' 181 
ElseIf Item.Class = olMeetingResponsePositive Or _ 
    Item.Class = olMeetingResponseTentative Or _ 
    Item.Class = olMeetingResponseNegative Or _ 
    Item.Class = 53 Or _ 
    Item.Class = 54 Or _ 
    Item.Class = 55 Or _ 
    Item.Class = 56 Or _ 
    Item.Class = 57 Or _ 
    Item.Class = 181 Then 

    ' Bypass errors for a specific purpose 
    On Error Resume Next 
    Set objAppt = Item.GetAssociatedAppointment(True) 
    ' Turn error bypass off 
    On Error GoTo 0 

    If objAppt Is Nothing Then 
     MsgBox "No appointment associated with the meeting response " & _ 
      vbCr & vbCr & Item.Subject 
     Exit Sub 
    End If 

Else 
    MsgBox "Item class " & Item.Class & " not recognized in this code. " 
    Exit Sub 

End If 

For Each objAttendee In objAppt.Recipients 

    Debug.Print 
    Debug.Print "Invitee name...: " & objAttendee.name 

    'Count the invitations 

    Debug.Print "Invitation Type: " & objAttendee.Type 

    ' https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/olmeetingrecipienttype-enumeration-outlook 
    ' 0 = olOrganizer 
    ' 1 = olRequired 
    ' 2 = olOptional 
    ' 3 = olResource 

    Select Case objAttendee.Type 

     Case 0 
      lOrganizerAttendeeCount = lOrganizerAttendeeCount + 1 

     Case 1 
      lRequiredAttendeeCount = lRequiredAttendeeCount + 1 

     Case 2 
      lOptionalAttendeeCount = lOptionalAttendeeCount + 1 

     Case 3 
      lResourceCount = lResourceCount + 1 

    End Select 

    ' Count the responses 

    Debug.Print "Response Status: " & objAttendee.MeetingResponseStatus 

    ' https://msdn.microsoft.com/VBA/Outlook-VBA/articles/olresponsestatus-enumeration-outlook 
    ' 0 = "None" - This is what I get as the organizer 
    ' 1 = "Organized" 
    ' 2 = "Tentative" 
    ' 3 = "Accepted" 
    ' 4 = "Declined" 
    ' 5 = "Not Responded" 

    Select Case objAttendee.MeetingResponseStatus 

     Case 0 
      attendeeOrganizerNoneCount = attendeeOrganizerNoneCount + 1 

     Case 1 
      attendeeOrganizerNoneCount = attendeeOrganizerNoneCount + 1 

     Case 2 
      attendeeTentativeCount = attendeeTentativeCount + 1 

     Case 3 
      attendeeAcceptedCount = attendeeAcceptedCount + 1 

     Case 4 
      attendeeDeclinedCount = attendeeDeclinedCount + 1 

     Case 5 
      attendeeNotRespondedCount = attendeeNotRespondedCount + 1 

    End Select 

    Set objAttendee = Nothing 

Next 

invitedAttendees = lOrganizerAttendeeCount + lRequiredAttendeeCount + _ 
        lOptionalAttendeeCount + lResourceCount 

respondingAttendees = attendeeOrganizerNoneCount + attendeeAcceptedCount + _ 
        attendeeTentativeCount + attendeeDeclinedCount + attendeeNotRespondedCount 

' Display results 
uTitle = "Attendees for " & objAppt.Subject 

uPrompt = "Invitations:" & vbCr & _ 
    " " & lOrganizerAttendeeCount & " :Organizer" & vbCr & _ 
    " " & lRequiredAttendeeCount & " :Required" & vbCr & _ 
    " " & lOptionalAttendeeCount & " :Optional" & vbCr & _ 
    " " & lResourceCount & " :Resource" & vbCr & _ 
    " " & invitedAttendees & " : TOTAL" & vbCr & vbCr 

uPrompt = uPrompt & " Responses:" & vbCr & _ 
    " " & attendeeOrganizerNoneCount & " :organizer none" & vbCr & _ 
    " " & attendeeAcceptedCount & " :accepts" & vbCr & _ 
    " " & attendeeTentativeCount & " :tentatives" & vbCr & _ 
    " " & attendeeDeclinedCount & " :declines" & vbCr & _ 
    " " & attendeeNotRespondedCount & " :no responses" & vbCr & _ 
    " " & respondingAttendees & " : TOTAL" 

    MsgBox Prompt:=uPrompt, Title:=uTitle 

ExitRoutine: 
    Set objAppt = Nothing 
    Set objAttendee = Nothing 

End Sub 
+0

나는 당신의 말을 듣고 있습니다. 솔루션에서 해체하고 섹션으로 시도해 보겠습니다. 지금은 폴더 항목을 계산하도록 설정 했으므로 매크로를 사용하여 개수를 유지하고 템플릿으로 자동 응답하려면 해당 폴더로 응답을 이동하는 규칙을 설정했습니다. 참석자 수를 세는 것은 훨씬 더 깔끔한 해결책이 될 것입니다. 만약 내가 충분히 용감하다면, 나는 자동으로 취소를 시도 할 것입니다 .-D 잠시 후에 다시 한번 시도해 보겠습니다. –

+1

@Jakes 응답에는 이제 응답 수가 포함됩니다. – niton