约会邀请不会发送VBA答案

【问题标题】：Appointment invite wont send VBA约会邀请不会发送VBA
【发布时间】：2019-02-25 04:28:28
【问题描述】：

我不经常在 VBA 中工作，我修改了下面的代码以满足我的需要，并且它可以实际发送约会邀请。当我在 Outlook 中打开它时，会列出与会者，但我必须从 Outlook 手动发送。我没有收到任何错误或任何表明它没有发送的迹象。任何其他关于优化和约定的技巧也值得赞赏，我相信对于一些更好的程序员来说，这很痛苦。另外，我知道这与网站上的其他问题类似，但它们的不同之处足以让我很难弄清楚我到底需要做什么，因此感谢您的耐心等待。

谢谢:)

Sub RegisterAppointmentList()
'Adds a list of appointments to the Calendar in Outlook
Dim olApp As New Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim r As Long

On Error Resume Next
Worksheets("Schedule").Activate 'Insures that the correct sheet is selected, needs to be updated if rename
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0

If olApp Is Nothing Then 'If GetObject fails then creates a new Application Object

    On Error Resume Next
    Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    If olApp Is Nothing Then
        MsgBox "Outlook is not available!"
        Exit Sub
    End If

End If

r = 2 'First row with appointment data in the active worksheet, ignores headers

'Declares variables for Outlook Parameters

Dim myStart, myEnd, myUnitBefore
Dim myAttendee As Outlook.Recipient

While Len(Cells(r, 1).Text) <> 0 And Len(Cells(r, 4).Text) <> 0

    'Sets Default Values of 8:00am and 8:30am as start and end times if no value found
    If Cells(r, 5) = "" Then
        myStart = DateValue(Cells(r, 4).Value) + "8:00:00 AM"
    Else:
        myStart = DateValue(Cells(r, 4).Value) + Cells(r, 5).Value    'Concatenates Date and Start Time to single value
    End If

    If Cells(r, 6) = "" Then
        myEnd = DateValue(Cells(r, 4).Value) + "8:30:00 AM"
    Else
        myEnd = DateValue(Cells(r, 4).Value) + Cells(r, 6).Value 'Concatenates Date and End Time to single value
    End If

    'Set "Minutes Before" if "Days" "Hours" or "Weeks" are selected.
    If Cells(r, 9) = "Hours" Then
        myUnitBefore = 60
    ElseIf Cells(r, 9) = "Days" Then
        myUnitBefore = 24 * 60
    ElseIf Cells(r, 9) = "Weeks" Then
        myUnitBefore = 24 * 60 * 7
    Else
        myUnitBefore = 1
    End If

    Set olAppItem = olApp.CreateItem(olAppointmentItem) 'Creates a new appointment

    With olAppItem

        On Error Resume Next
        .Subject = Cells(r, 1)
        .Location = Cells(r, 2)
        .Body = .Subject & " - " & Cells(r, 3).Value
        .Start = myStart
        .End = myEnd
        .ReminderSet = Cells(r, 7)
        .ReminderMinutesBeforeStart = Cells(r, 8).Value * myUnitBefore
        .Categories = Cells(r, 10).Text & " Category"   'Allows using dropdown to set Category.
        Set myAttendee = olAppItem.Recipients.Add(Cells(r, 11))

        If Cells(r, 12) = "Free" Then
            .BusyStatus = olFree
        Else
            .BusyStatus = olBusy
        End If

        On Error GoTo 0

        .Save 'Saves the new appointment to the default folder
        .Send 'Doesn't seem to work...

    End With

    r = r + 1 'Cycle until all rows of events have been created

Wend

'Clear Objects when done
Set olAppItem = Nothing
Set olApp = Nothing

【问题讨论】：

您可能会发现。发送已禁用。 stackoverflow.com/questions/48104512/… 对于未来的问题，请尝试删除不必要的代码。很少有可能的回答者会忽略这个问题。 stackoverflow.com/help/mcve
请注释掉或删除所有以 'On Error' 开头的行 - 如果有任何问题，这些只是隐藏它们。报告您的发现，我们应该能够提供帮助。
.Send 可能被禁用，我无法更改设置，因此该方法可能不是一个选项。我删除了所有 On Error 行，我没有收到任何错误。

标签： excel vba outlook send appointment

【解决方案1】：

B.烈焰人

我不确定您是要创建约会还是会议？

但是，Meetings 和 Appointments 的区别在于会议有与会者，而约会没有。

所以如果你要创建一个会议，你应该设置“olAppItem.MeetingStatus = olMeeting”属性。

欲了解更多信息，请查看以下链接：

AppointmentItem.MeetingStatus Property

【讨论】：