Excel создает приглашение на собрание Outlook, не может отправить - PullRequest
1 голос
/ 20 ноября 2011

Я работаю над кодом, который создает запрос на собрание 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

Ответы [ 2 ]

6 голосов
/ 21 ноября 2011

Без примера строки значений трудно отладить этот код. Таким образом, мы только подтверждаем ваше слово, что оно действительно. Но я немного исправил код.

  • В вашем коде дважды есть ReminderMinutesBeforeStart . Я удалил первый, потому что похоже, что он зависит от данных строки.
  • Вы вызываете метод ResolveAll , но не проверяете, разрешены ли ваши получатели. Если бы это были адреса электронной почты, я бы не стал беспокоиться.
  • Существует смесь ранних и поздних связанных ссылок. Например, вы используете 1 вместо olAppointmentItem, но позже используете olMeeting вместо 1.
  • Свойство AllDayEvent принимает логическое значение, но, поскольку вы не объявили никаких переменных, мы не можем сказать, что означает AllDay . Я преобразовал это, чтобы читать из столбца I. Также обратите внимание, что если вы установите AllDayEvent в True, вам не нужно будет устанавливать Duration.

Предполагая допустимые значения ввода, этот код работал для меня:

Option Explicit

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
      .MeetingStatus = olMeeting
      ' not necessary if recipients are email addresses
      ' myapt.Recipients.ResolveAll
      .AllDayEvent = Cells(r, 9).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

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

Пример входных значений в ячейках (включая строку заголовка):

  • A2: Мое собрание
  • B2: Мой стол
  • C2: 25.11.2011 13:30:00
  • D2: 30
  • E2: 2
  • F2: 30
  • G2: Давайте встретимся!
  • H2: -адрес электронной почты-
  • I2: ЛОЖЬ
0 голосов
/ 24 мая 2013

Это работает для меня!

Имейте в виду, чтобы несколько строк, например

.Recipients.Add Cells(r, 8).value

, добавляли больше получателей.Поскольку запись нескольких адресов в одну ячейку разделена символом ";"приводит к ошибке при отправке на прием!

или использовании

.Recipients.ResolveAll 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...