如何在Outlook中添加另一个之前计算会议参与者
问题描述:
在添加另一个会议并发送之前,我如何统计会议的总参与者?如何在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
任何想法都可以理解!
答
我认为这个问题太广泛了,可以分成至少三个不同的问题。关注“如何计算会议的总参与者数”,而无需添加和发送部分。我不得不假设你在响应到达时运行代码。
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
编辑2071010
中的问题点,邀请的计数的代码,但似乎你需要的响应计数。
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
我听到你在说什么。让我把它从你的解决方案中分解出来,然后分段尝试。现在我已经设置了它来计算文件夹项目,并且我已经设置了一个规则将响应移动到该文件夹中,以便使用宏保持计数并自动响应模板。 计算参加者将是一个更清洁的解决方案,也许,如果我足够勇敢,我会尝试自动取消取消:-D 我会再拍一点,然后回来。 –
@Jakes回答现在包括一系列回复 – niton