Πώς να στείλετε ένα ημερολόγιο σε πολλούς παραλήπτες ξεχωριστά στο Outlook;

Κανονικά, μπορείτε να στείλετε ένα ημερολόγιο σε έναν παραλήπτη γρήγορα και εύκολα χρησιμοποιώντας το Ημερολόγιο ηλεκτρονικού ταχυδρομείου δυνατότητα στο Outlook. Εάν θέλετε να στείλετε ένα ημερολόγιο που επισυνάπτεται ως αρχείο iCalendar σε πολλές επαφές ξεχωριστά, πρέπει να το στείλετε ένα προς ένα. Σε αυτό το άρθρο, θα μιλήσω για έναν εύκολο τρόπο αποστολής ημερολογίου σε πολλούς παραλήπτες ξεχωριστά στο Outlook.

Στείλτε ένα ημερολόγιο σε πολλούς παραλήπτες μεμονωμένα με κωδικό VBA

Στείλτε ένα ημερολόγιο σε πολλούς παραλήπτες μεμονωμένα με κωδικό VBA

Για να στείλετε ένα ημερολόγιο σε πολλούς παραλήπτες ξεχωριστά, ο ακόλουθος κώδικας VBA μπορεί να σας βοηθήσει, κάντε το εξής:

1. Πλοηγηθείτε στο Επικοινωνία και επιλέξτε τις επαφές στις οποίες θέλετε να στείλετε ημερολόγιο.

2. Στη συνέχεια, κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

3. Κλίκ Κύριο θέμα > Μονάδα μέτρησης, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα στην ανοιχτή κενή ενότητα, δείτε το στιγμιότυπο οθόνης:

Κωδικός VBA: Αποστολή ημερολογίου σε πολλούς παραλήπτες ξεχωριστά:

Sub EmailCalendarToMultiplePersonsSeparately()
Dim xSelection As Outlook.Selection
Dim xCalendarFolder As Outlook.Folder
Dim xCalendarExporter As Outlook.CalendarSharing
Dim xStartDate, xEndDate As Date
Dim xCalendarFile As String
Dim xContactItem As Outlook.ContactItem
Dim xDistListItem As Outlook.DistListItem
Dim xItem As Object
Dim xMailItem As Outlook.MailItem
Dim xFilePath, xFileName, xEmailAddress As String
Dim xRecipient As Recipient
On Error Resume Next
xFilePath = CreateObject("WScript.Shell").SpecialFolders(16) & "\MyCalendar"
If Dir(xFilePath, vbDirectory) = "" Then MkDir xFilePath
If Outlook.Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
    MsgBox "Please Select contacts first!", vbExclamation + vbOKOnly, "Kutools for Outlook"
    Exit Sub
End If
Set xSelection = Outlook.Application.ActiveExplorer.Selection
If xSelection Is Nothing Then Exit Sub
Set xCalendarFolder = Outlook.Application.Session.PickFolder
If xCalendarFolder Is Nothing Then Exit Sub
If xCalendarFolder.DefaultItemType <> olAppointmentItem Then Exit Sub
Set xCalendarExporter = xCalendarFolder.GetCalendarExporter
xStartDate = InputBox("Enter the start date:", "Kutools for Outlook", "")
If Len(Trim(xStartDate)) = 0 Then Exit Sub
xEndDate = InputBox("Enter the end date:", "Kutools for Outlook", "")
If Len(Trim(xEndDate)) = 0 Then Exit Sub
If xStartDate = #1/1/4501# Or xEndDate = #1/1/4501# Then Exit Sub
xFileName = "Calendar (" & Format(xStartDate, "YYYYMMDD") & " - " & Format(xEndDate, "YYYYMMDD") & ").ics"
xCalendarFile = xFilePath & "\" & xFileName
With xCalendarExporter
    .IncludeWholeCalendar = False
    .StartDate = xStartDate
    .EndDate = xEndDate
    .CalendarDetail = olFullDetails
    .IncludeAttachments = True
    .IncludePrivateDetails = False
    .RestrictToWorkingHours = False
    .SaveAsICal xCalendarFile
End With
For Each xItem In xSelection
    If xItem.Class = olContact Then
        Set xContactItem = xItem
        Set xMailItem = Outlook.Application.CreateItem(olMailItem)
        With xMailItem
            .To = xContactItem.Email1Address
            .Recipients.ResolveAll
            .Subject = xFileName
            .Attachments.Add xCalendarFile
            .Body = "Dear " & xContactItem.FullName & "," & vbCrLf & "Type body here..."
            .Display
        End With
    End If
    If xItem.Class = olDistributionList Then
        Set xDistListItem = xItem
        For i = 1 To xDistListItem.MemberCount
            Set xRecipient = xDistListItem.GetMember(i)
            Set xMailItem = Outlook.Application.CreateItem(olMailItem)
            With xMailItem
                .To = xRecipient.AddressEntry.Address
                .Recipients.ResolveAll
                .Subject = xFileName
                .Attachments.Add xCalendarFile
                .Body = "Dear " & xRecipient.Name & "," & vbCrLf & "Type body here..."
                .Display
            End With
        Next i
    End If
Next
End Sub

4. Αφού εισαγάγετε τον κωδικό και πατήστε F5 κλειδί για την εκτέλεση αυτού του κώδικα, και a Επιλογή φακέλου εμφανίζεται το παράθυρο διαλόγου, επιλέξτε ένα ημερολόγιο που θέλετε να στείλετε, δείτε το στιγμιότυπο οθόνης:

5. Πατήστε OKκαι, στη συνέχεια, καθορίστε το εύρος ημερομηνιών που θέλετε να στείλετε το ημερολόγιο στα ακόλουθα πλαίσια προτροπής, δείτε το στιγμιότυπο οθόνης:

6. Και μετά, κάντε κλικ στο OK, έχουν δημιουργηθεί νέα μηνύματα ηλεκτρονικού ταχυδρομείου με συνημμένο ημερολόγιο, όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης, και απλώς πρέπει να τα στείλετε ένα προς ένα.