时间戳

首页 > 解决方案 > 使用 Excel 发送 Outlook 会议邀请

excel - 使用 Excel 发送 Outlook 会议邀请

问题描述

我希望为工作表中的每一行发送会议邀请。

我可以创建一个显示为约会的项目，而不是可以发送给其他人的会议请求。我需要在 Outlook 中单击“邀请与会者”，然后显示电子邮件地址，我可以发送，但如果我有超过几行，则需要很长时间。

这似乎是一个常见问题，因为我在其他论坛中发现了这个问题，但没有一个对我有用的解决方案。

Sub SendAction()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In Worksheets("Action Log").Range("H5:H50").Cells
        Set OutMail = OutApp.CreateItem(1)
        If cell.Value Like "*@*" Then      'try with less conditions first
            With OutMail
                .MeetingStatus = olMeeting
                .RequiredAttendees = Cells(cell.Row, "H").Value
                .Subject = Cells(cell.Row, "I").Value
                .Body = Cells(cell.Row, "I").Value
                .Start = Cells(cell.Row, "E").Value & " " & TimeValue("8:00 AM")
                .Location = "Your Office"
                .Duration = 15 ' 15 minute meeting
                .BusyStatus = 0 ' set as free
                .ReminderSet = True 'reminder set
                .ReminderMinutesBeforeStart = "20160" 'reminder 2 weeks before
                .display                
            End With

            Cells(cell.Row, "K").Value = "sent"
            Set OutMail = Nothing
        End If
    Next cell

    Application.ScreenUpdating = True

End Sub

这是我尝试过的一种替代方法，但没有解决问题：

Application.Wait DateAdd("s", 2, Now)       'waiting for 2 sec to let OL window to display.
SendKeys "%s", True                         'Sending Mail.
Set olApt = Nothing

MsgBox "Invite Sent", vbInformation

来源：https ://excel-buzz.blogspot.com/2015/03/automation-sending-invitation-to.html

另一种选择是更改.Display为，.Save但.Send无论哪种方式，该功能都不起作用，然后我需要从 Outlook 中的草稿邮件中打开会议请求。

标签： excelvba

解决方案

试试这个？

子发送动作（）

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Worksheets("Action Log").Range("H5:H50").Cells
    Set OutMail = OutApp.CreateItem(1)
    If cell.Value Like "*@*" Then      'try with less conditions first
        With OutMail
            .MeetingStatus = olMeeting
            .RequiredAttendees = Cells(cell.Row, "H").Value
            .RequiredAttendees.Type = olRequired
            .Subject = Cells(cell.Row, "I").Value
            .Body = Cells(cell.Row, "I").Value
            .Start = Cells(cell.Row, "E").Value & " " & TimeValue("8:00 AM")
            .Location = "Your Office"
            .Duration = 15 ' 15 minute meeting
            .BusyStatus = 0 ' set as free
            .ReminderSet = True 'reminder set
            .ReminderMinutesBeforeStart = "20160" 'reminder 2 weeks before
            .display
            .send

        End With

        Cells(cell.Row, "K").Value = "sent"
        Set OutMail = Nothing
    End If
Next cell

Application.ScreenUpdating = True

结束子

推荐阅读