Question

我不是编码器，并且在VBA或脚本编写方面的知识基础不足。我将这段代码拼凑在一起，这将采用excel电子表格（每行一次会议）并生成日历邀请，完成主题，日期/时间和＆amp;与会者。这个appointmentItem正在我的日历上生成，但我需要它在我的共享日历上打开。注意事项：我不知道执行此操作需要哪些代码，而且我不了解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

Answer 1

要在共享日历上创建约会，您需要使用来自共享caledar文件夹的Items类的Add方法。 How To: Create a new Outlook Appointment item解释了在Outlook中创建约会项目的不同方法。注意，您可以使用Namespace类的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

VBA脚本用于从Excel生成日历邀请 - 但是来自共享日历

1 个答案: