我正在尝试调整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中放入的示例数据。