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
私はこれで参加者をカウントすることができましたが、私は、すべての任意のアイデアが理解されるであろう2 ...
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
を結合しようと迷ってしまいました！
あなたの意見を聞いています。私はあなたの解決策からそれを分解してから、それをセクションで試してみましょう。今のところ私はフォルダ項目を数えるように設定しており、カウントを維持して自動的にテンプレートで応答するためにマクロを使用するためには、応答をそのフォルダに移動するルールを設定しました。 出席者を数えることはもっとクリーンな解決策になるでしょう。もし私が勇気があれば、私は自動的にキャンセルを取り除こうとします:-D もう一度もう一度撮影して戻ってきます。 –
@Jakes回答には現在、応答数が含まれています – niton