应用程序 - 定义或对象定义的错误,引用Outlook VBA中的Excel单元格

时间:2017-09-26 06:19:38

标签: excel excel-vba outlook vba

以下是我为自动发送会议邀请而编写的代码。

代码从工作表中的单元格中选取内容:Final_List。

当我尝试从Excel获取收件人地址时,我突出显示了我收到错误的位置

  

应用程序 - 定义或对象定义的错误。

Dim outlookApp As Outlook.Application
Dim outlookmeet As AppointmentItem
Dim myRequiredAttendee As Recipient

Dim sh As Worksheet
Dim RowCount As Long

RowCount = 2
'row 1 has headers

With Worksheets("Final_List")

    Do While IsEmpty(Cells(RowCount, 1).Value) = False

        Set outlookApp = CreateObject("Outlook.Application")
        Set outlookmeet = outlookApp.CreateItem(olAppointmentItem)
        With outlookmeet

            .MeetingStatus = olMeeting

            .Subject = Cells(RowCount, 1).Value & " - " & Cells(RowCount, 2).Value
            .Location = Cells(RowCount, 3).Value
            .Start = Cells(RowCount, 5).Value
            .Duration = Cells(RowCount, 7).Value

            'getting errors on this line                     
            .Recipients.Add (Cells(RowCount, 6).Value)

            .Recipients.ResolveAll

            .Body = Cells(RowCount, 4).Value
            .Send
        End With

        RowCount = RowCount + 1

    Loop
End With

Set outlookmeet = Nothing
Set outlookApp = Nothing
MsgBox "All invites sent!"

2 个答案:

答案 0 :(得分:0)

AppointmentItem对象没有Recipient属性。 Compare MSDN library

答案 1 :(得分:0)

我得到了这个解决方案:

Sub ScheduleMeeting()

    Dim outlookApp As Outlook.Application
    Dim outlookmeet As Outlook.AppointmentItem

    Dim RowCount As Long
    Dim Name1 As Variant

    RowCount = 2
    'row 1 has headers
    Worksheets("MeetingInvite").Activate

    With Worksheets("MeetingInvite")

        Do While IsEmpty(Cells(RowCount, 1).Value) = False

            Set outlookApp = CreateObject("Outlook.Application")
            Set outlookmeet = outlookApp.CreateItem(olAppointmentItem)

            With outlookmeet

                .MeetingStatus = olMeeting
                .Subject = Cells(RowCount, 1).Value 
                .Location = Cells(RowCount, 2).Value
                .Start = Cells(RowCount, 4).Value
                .Duration = Cells(RowCount, 6).Value

                .RequiredAttendees = Cells(RowCount, 5).Value

                .Body = Cells(RowCount, 3).Value

                .Display

            End With

            RowCount = RowCount + 1

        Loop
    End With

    Set outlookmeet = Nothing
    Set outlookApp = Nothing
    'MsgBox "All invites sent!"

End Sub