使用 Excel 数据创建 Outlook 会议请求
我正在编写代码来创建 Outlook 会议请求以发送给受邀者列表。
我在日历中看到会议请求,但无法发送。
我怎样才能让它发送?
Sub AddAppointments()
' Create the Outlook session
Set myOutlook = CreateObject("Outlook.Application")
' Start at row 2
r = 2
Do Until Trim(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myApt = myOutlook.CreateItem(1)
' Set the appointment properties
myApt.Subject = Cells(r, 1).Value
myApt.Location = Cells(r, 2).Value
myApt.Start = Cells(r, 3).Value
myApt.Duration = Cells(r, 4).Value
myApt.Recipients.Add Cells(r, 8).Value
myApt.MeetingStatus = olMeeting
myApt.ReminderMinutesBeforeStart = 88
myApt.Recipients.ResolveAll
myApt.AllDayEvent = AllDay
' If Busy Status is not specified, default to 2 (Busy)
If Trim(Cells(r, 5).Value) = "" Then
myApt.BusyStatus = 2
Else
myApt.BusyStatus = Cells(r, 5).Value
End If
If Cells(r, 6).Value > 0 Then
myApt.ReminderSet = True
myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
myApt.ReminderSet = False
End If
myApt.Body = Cells(r, 7).Value
myApt.Save
r = r + 1
myApt.Send
Loop
End Sub
I am working on code to create an Outlook Meeting Request to send to a list of invitees.
I see the Meeting Request in my Calendar, but I am unable to send it.
How can I get it to send?
Sub AddAppointments()
' Create the Outlook session
Set myOutlook = CreateObject("Outlook.Application")
' Start at row 2
r = 2
Do Until Trim(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myApt = myOutlook.CreateItem(1)
' Set the appointment properties
myApt.Subject = Cells(r, 1).Value
myApt.Location = Cells(r, 2).Value
myApt.Start = Cells(r, 3).Value
myApt.Duration = Cells(r, 4).Value
myApt.Recipients.Add Cells(r, 8).Value
myApt.MeetingStatus = olMeeting
myApt.ReminderMinutesBeforeStart = 88
myApt.Recipients.ResolveAll
myApt.AllDayEvent = AllDay
' If Busy Status is not specified, default to 2 (Busy)
If Trim(Cells(r, 5).Value) = "" Then
myApt.BusyStatus = 2
Else
myApt.BusyStatus = Cells(r, 5).Value
End If
If Cells(r, 6).Value > 0 Then
myApt.ReminderSet = True
myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
Else
myApt.ReminderSet = False
End If
myApt.Body = Cells(r, 7).Value
myApt.Save
r = r + 1
myApt.Send
Loop
End Sub
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
如果没有示例值行,则很难调试此代码。所以我们只是相信你的话,它是有效的。但我确实稍微修改了代码。
假设有效的输入值,此代码对我有用:
单元格中的示例输入值(包括标题行):
Without a sample row of values, it's hard to debug this code. So we are only going on your word that it is valid. But I did fix up the code a bit.
Assuming valid input values, this code worked for me:
Sample input values in cells (incl. header row):
这对我有用!
请记住有多行,例如
添加更多收件人。
因为在一个单元格中写入多个地址,并用“;”分隔。发送约会时会导致错误!
或使用
It works for me!
Please keep in mind to have multiple lines like
to add more recipients.
Because writing several addresses in one cell separeted by ";" leads to an error when sendig the appointment!
or use