Неправильное время и дата начала при отправке более одного приглашения Outlook с помощью Excel VBA - PullRequest
0 голосов
/ 29 октября 2018

Я пытаюсь настроить VBA для отправки приглашения, чтобы отправить последовательность приглашений.

Время и дата встречи неверны после отправки первого приглашения. -> Я имею в виду приглашение Outlook, сгенерированное приведенным ниже кодом, неправильно. В таблице приведены входные данные.

Ссылка: Исходное сообщение

Вот мой код:

Option Explicit
Public Sub CreateOutlookAppointmentQGAll()
    Sheets("SendOutlookInvite_Group Test").Select
    On Error GoTo Err_Execute

    Dim olApp As Outlook.Application
    Dim olAppt As Outlook.AppointmentItem
    Dim blnCreated As Boolean
    Dim olNs As Outlook.Namespace
    Dim CalFolder As Outlook.MAPIFolder

    Dim i As Integer
    i = 3
    On Error Resume Next
    Set olApp = Outlook.Application

    If olApp Is Nothing Then
        Set olApp = Outlook.Application
         blnCreated = True
        Err.Clear
    Else
        blnCreated = False
    End If

    On Error GoTo 0

    Set olNs = olApp.GetNamespace("MAPI")
    Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

    Do Until i > 7 'Set loop for sending all invitation at once
        Set olAppt = CalFolder.Items.Add(olAppointmentItem)
        With olAppt
            .MeetingStatus = olMeeting

            'Define calendar item properties
            .Subject = Cells(i, 1)

            ' do not use location if using a resource
            .Location = Cells(i, 2)
            .Body = Cells(i, 3)

            'Define start and end time in calendar
            .Start = (Cells(i, 5) + Cells(i, 6))
            .End = (Cells(i, 7) + Cells(i, 8))

            'Define status
            .BusyStatus = olBusy
            .ReminderMinutesBeforeStart = Cells(i, 9)
            .ReminderSet = True

            ' get the recipients
            Dim RequiredAttendee, OptionalAttendee, OptionalAttendee2, As Outlook.Recipient
            Set RequiredAttendee = .Recipients.Add(Cells(i, 10).Value)
            RequiredAttendee.Type = olRequired
            Set OptionalAttendee = .Recipients.Add(Cells(i, 11).Value)
            OptionalAttendee.Type = olOptional
            Set OptionalAttendee2 = .Recipients.Add(Cells(i, 12).Value)
            OptionalAttendee2.Type = olOptional

            ' For meetings or Group Calendars
            .Send
        End With

        i = i + 1

        Set olAppt = Nothing
        Set olApp = Nothing
    Loop

    Exit Sub      
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar."
End Sub

Вот пример данных, которые я поместил в Excel.

Attached image

Результат соответствующего приглашения. Attached image

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...