从 Excel 生成日历邀请的 VBA 脚本 - 但来自共享日历答案

【问题标题】：VBA Script to generate Calendar Invites from Excel - but from a Shared Calendar从 Excel 生成日历邀请的 VBA 脚本 - 但来自共享日历
【发布时间】：2015-01-12 19:49:51
【问题描述】：

我不是编码员，对 VBA 或脚本的基本知识基础还不够。我将这段代码拼凑在一起，它将获取一个 Excel 电子表格（每行一个会议）并生成一个包含主题、日期/时间和与会者的日历邀请。此约会项正在我的日历上生成，但我需要在我的共享日历上打开它。警告：我不知道执行此操作需要什么代码，而且我不知道 Outlook 日历路径的格式。这些帐户链接到我的公司服务器，我们在全局目录中使用别名.

Sub AddAppointments()

    Dim myoutlook As Object ' Outlook.Application
    Dim r As Long
    Dim myapt As Object ' Outlook.AppointmentItem

    ' late bound constants
    Const olAppointmentItem = 1
    Const olBusy = 2
    Const olMeeting = 1

    ' 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(olAppointmentItem)
        ' Set the appointment properties
        With myapt
            .Subject = Cells(r, 1).Value
            .Location = Cells(r, 2).Value
            .Start = Cells(r, 3).Value
            .Duration = Cells(r, 4).Value
            '.Recipients.Add Cells(r, 8).Value


            ' **Why Doesn't this Work?!?**
            .Recipients.ResolveAll



            .MeetingStatus = olMeeting
            ' not necessary if recipients are email addresses
            .AllDayEvent = Cells(r, 31).Value

            ' If Busy Status is not specified, default to 2 (Busy)
            If Len(Trim$(Cells(r, 5).Value)) = 0 Then
                .BusyStatus = olBusy
            Else
                .BusyStatus = Cells(r, 5).Value
            End If

            If Cells(r, 6).Value > 0 Then
                .ReminderSet = True
                .ReminderMinutesBeforeStart = Cells(r, 6).Value
            Else
                .ReminderSet = False
            End If
            'Set body format to HTML - ** THIS DOESN'T WORK **
            '.BodyFormat = olFormatHTML
            '.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"

            .Body = Cells(r, 7).Value
            .Save
            r = r + 1
            .Send
        End With
    Loop
End Sub

【问题讨论】：

标签： vba excel calendar outlook-addin

【解决方案1】：

要在共享日历上创建约会，您需要使用来自共享日历文件夹的 Items 类的 Add 方法。 How To: Create a new Outlook Appointment item 解释了在 Outlook 中创建约会项目的不同方法。注意，您可以使用命名空间类的GetSharedDefaultFolder 方法来获取共享日历文件夹。

  ' **Why Doesn't this Work?!?**
   .Recipients.ResolveAll

您似乎需要先将任何收件人添加到收件人集合中。例如：

Sub CreateAppt()  
  Dim myItem As Object  
  Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient 
  Set myItem = Application.CreateItem(olAppointmentItem)  
  myItem.MeetingStatus = olMeeting  
  myItem.Subject = "Strategy Meeting"  
  myItem.Location = "Conference Room B"  
  myItem.Start = #9/24/2014 1:30:00 PM#  
  myItem.Duration = 90  
  Set myRequiredAttendee = myItem.Recipients.Add("Nate Sun")  
  myRequiredAttendee.Type = olRequired  
  Set myOptionalAttendee = myItem.Recipients.Add("Kevin Kennedy")  
  myOptionalAttendee.Type = olOptional  
  Set myResourceAttendee = myItem.Recipients.Add("Conference Room B")  
  myResourceAttendee.Type = olResource  
  myItem.Display  
End Sub

【讨论】：

嗨，尤金。谢谢你的目光。我查看了 GetSharedDefaultFolder 链接中提到的代码。提供的描述似乎与我正在寻找的目标一致。我不想要求手持，但你能更新我的原始代码以包含 GetSharedDefaultFolder 方法吗？当我尝试插入它时，我似乎无法调试它。另外，我明白我应该将“Dan Wilson”更改为我的目标同事，然后解析地址；但什么是 MAPI？我应该把我的名字放在代码的那部分吗？
是的，你在正确的道路上。您需要更改名称以改为针对您的同事。你是组织者，而不是接受者。