Excel-创建的 Outlook 约会只通知我
Excel-created Outlook appointment only notifies me
我正在尝试在工作中设置 Outlook 日历,来自 Excel 数据 sheets。
我运行查询获取数据,然后处理它,并填充 Outlook 日历事件。
问题是,当我通过 olAppointmentItem 输入所需的与会者时,它只会通知我并填写我的日历,而不是我同事的日历。
我认为这可能是因为我是从我自己的 Outlook 帐户创建的。
这是我的映射 Excel sheet:
这是我使用的代码:
Sub RegisterAppointmentList()
' adds a list of appointments to the Calendar in Outlook
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim row As Long
On Error Resume Next
Worksheets("to_be_added").Activate 'worksheet with the list of my appointments to be added
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not available!"
Exit Sub
End If
End If
row = 2 ' first row with appointment data in the active worksheet
Dim mysub, myStart, myEnd
While Len(Cells(row, 2).text) <> 0
mysub = "Test"
myStart = DateValue("09/20/2019") + TimeValue("8:00") 'date and time
myEnd = DateValue("09/20/2019") + TimeValue("9:00") 'date and time
Set olAppItem = olApp.CreateItem(olAppointmentItem)
' set default appointment values
.Location = "Office" 'Location of my event
.Body = "Test appointment" 'title
.ReminderSet = True
.BusyStatus = olBusy 'doesn't need to set people busy
```
.RequiredAttendees = "me@company.com" 'this works just fine
.RequiredAttendees = "colleague@company.com" 'this doesn't work
```
'On Error Resume Next
.Start = myStart
.End = myEnd
.AllDayEvent = False
.Subject = mysub
'.Location = Cells(row, 9).Value
'.Body = Cells(row, 8).Value
'.ReminderSet = True
'.BusyStatus = olBusy
.Categories = "In" 'My own categories (two possibilities, In or Out)
On Error GoTo 0
.Save
End With
row = row + 1
Wend
Set olAppItem = Nothing
Set olApp = Nothing
End Sub
我认为这只是一个没有捕捉到的参数之类的,因为它在我自己的日历上运行良好,我收到提醒和事件。
您创建了一个多余的约会 .RequiredAttendees
属性。
您没有尝试 .Send
。
Sub RegisterAppointmentList_SendMeetingInvitation_Minimal()
' Most Excel-related code is removed
' Create a meeting from an appointment
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim myStart As Date
Dim myEnd As Date
On Error Resume Next
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not available!"
Exit Sub
End If
End If
myStart = DateValue("09/21/2019") + TimeValue("8:00") 'date and time
myEnd = DateValue("09/21/2019") + TimeValue("9:00") 'date and time
Set olAppItem = olApp.CreateItem(olAppointmentItem)
With olAppItem
' set default appointment values
.Location = "Office" 'Location of my event
.Body = "Test appointment"
.ReminderSet = True
.BusyStatus = olBusy
.RequiredAttendees = "me@company.com"
.RequiredAttendees = "colleague@company.com"
.Start = myStart
.End = myEnd
.AllDayEvent = False
.Subject = "Test"
' Change appointment to meeting
.MeetingStatus = olMeeting
.Display ' change to .Send when tested
End With
End Sub
我正在尝试在工作中设置 Outlook 日历,来自 Excel 数据 sheets。
我运行查询获取数据,然后处理它,并填充 Outlook 日历事件。
问题是,当我通过 olAppointmentItem 输入所需的与会者时,它只会通知我并填写我的日历,而不是我同事的日历。
我认为这可能是因为我是从我自己的 Outlook 帐户创建的。
这是我的映射 Excel sheet:
这是我使用的代码:
Sub RegisterAppointmentList()
' adds a list of appointments to the Calendar in Outlook
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim row As Long
On Error Resume Next
Worksheets("to_be_added").Activate 'worksheet with the list of my appointments to be added
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not available!"
Exit Sub
End If
End If
row = 2 ' first row with appointment data in the active worksheet
Dim mysub, myStart, myEnd
While Len(Cells(row, 2).text) <> 0
mysub = "Test"
myStart = DateValue("09/20/2019") + TimeValue("8:00") 'date and time
myEnd = DateValue("09/20/2019") + TimeValue("9:00") 'date and time
Set olAppItem = olApp.CreateItem(olAppointmentItem)
' set default appointment values
.Location = "Office" 'Location of my event
.Body = "Test appointment" 'title
.ReminderSet = True
.BusyStatus = olBusy 'doesn't need to set people busy
```
.RequiredAttendees = "me@company.com" 'this works just fine
.RequiredAttendees = "colleague@company.com" 'this doesn't work
```
'On Error Resume Next
.Start = myStart
.End = myEnd
.AllDayEvent = False
.Subject = mysub
'.Location = Cells(row, 9).Value
'.Body = Cells(row, 8).Value
'.ReminderSet = True
'.BusyStatus = olBusy
.Categories = "In" 'My own categories (two possibilities, In or Out)
On Error GoTo 0
.Save
End With
row = row + 1
Wend
Set olAppItem = Nothing
Set olApp = Nothing
End Sub
我认为这只是一个没有捕捉到的参数之类的,因为它在我自己的日历上运行良好,我收到提醒和事件。
您创建了一个多余的约会 .RequiredAttendees
属性。
您没有尝试 .Send
。
Sub RegisterAppointmentList_SendMeetingInvitation_Minimal()
' Most Excel-related code is removed
' Create a meeting from an appointment
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim myStart As Date
Dim myEnd As Date
On Error Resume Next
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not available!"
Exit Sub
End If
End If
myStart = DateValue("09/21/2019") + TimeValue("8:00") 'date and time
myEnd = DateValue("09/21/2019") + TimeValue("9:00") 'date and time
Set olAppItem = olApp.CreateItem(olAppointmentItem)
With olAppItem
' set default appointment values
.Location = "Office" 'Location of my event
.Body = "Test appointment"
.ReminderSet = True
.BusyStatus = olBusy
.RequiredAttendees = "me@company.com"
.RequiredAttendees = "colleague@company.com"
.Start = myStart
.End = myEnd
.AllDayEvent = False
.Subject = "Test"
' Change appointment to meeting
.MeetingStatus = olMeeting
.Display ' change to .Send when tested
End With
End Sub