Excel VBA,就像Outlook的调度助手一样

时间:2015-08-07 06:06:24

标签: excel vba excel-vba outlook-vba

是创建VBA代码的新手,不能单独编写一个。是否可以创建一个像Outlook的调度助手一样工作的VBA代码?我希望它像调度助手一样工作。我试过freebusy,但它显示" Object不支持这种方法"

我在这个部分,我可以使用excel信息发送详细信息。

    Option Explicit

    Sub AddAppointments()

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

      ' 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(2, 1).Value
          .Location = Cells(3, 1).Value
          .Start = Cells(4, 1).Value
          time = .Start
          .Duration = Cells(5, 1).Value
          .Recipients.Add Cells(8, 1).Value & ";" & _
          Cells(8, 2).Value & ";" & _
          Cells(8, 3).Value & ";" & _
          Cells(8, 4).Value & ";" & _
          Cells(8, 5).Value & ";" & _
          Cells(8, 6).Value & ";" & _
          Cells(8, 7).Value & ";" & _
          Cells(8, 8).Value & ";" & _
          Cells(8, 9).Value & ";" & _
          Cells(8, 10).Value

          .MeetingStatus = olMeeting
          ' not necessary if recipients are email addresses
          myapt.Recipients.ResolveAll
          'myapt.Recipients.FreeBusy = "(#8/8/2015#, 60, False)"
         ' .AllDayEvent = Cells(9, 1).Value

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

          If Cells(6, 1).Value > 0 Then
            .ReminderSet = True
            .ReminderMinutesBeforeStart = Cells(6, 1).Value
          Else
            .ReminderSet = False
          End If

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

1 个答案:

答案 0 :(得分:0)

FreeBusy方法由Recipient对象实现。您可以在收件人上调用该方法(请注意复数" s")对象。遍历所有收件人并在每个收件人上调用FreeBusy。

或使用Recipients.Add

返回的Recipient对象

它还会显示您传递多个收件人,这些收件人用";"致来自Recipients.Add。您必须为每个收件人调用Recipients.Add。或者您可以设置To属性(它允许多个收件人用";"分隔。)。