使用Excel VBA发送多个Outlook邀请时,开始时间和日期不正确

时间:2018-10-29 10:00:33

标签: excel vba outlook outlook-vba

我正在尝试调整VBA以发送邀请以发送一系列邀请。

发送第一个邀请后,会议的时间和日期不正确。 ->我的意思是下面的代码生成的Outlook邀请错误。该表显示了输入数据。

参考:Original Post

这是我的代码:

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

0 个答案:

没有答案