VBA Excel创建Outlook 2013约会

Question

I am trying to create an Outlook Appointment with a Macro, I am having an issue with the code giving me an error of "Object Doesn't support this property or method" when it comes the Default Appointment Values. I have tried several fixes but am not experienced enough to resolve. Any assistance is greatly appreciated.

Here is what I am working with:

Sub CalendarInvite()

    Dim olApp As Object
    Dim olAppItem As Object
    Dim r As Long

    Set olApp = GetObject("", "Outlook.Application")

    Dim mysub, myStart, myEnd

        mysub = Range("Title")
        myStart = Range("Date")
        myEnd = Range("Date")

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

        'set default appointment values
        With olAppItem
            .Location = Range("Location")
            .Body = Range("Body")
            .ReminderSet = True
            .BusyStatus = olFree
            .RequiredAttendees = "email@email.com"
            'saves the new appointment to the default folder
            .Save
        End With

    Set olAppItem = Nothing
    Set olApp = Nothing

End Sub

Answer 1

 Set olAppItem = olApp.CreateItem(olAppointmentItem) 

Assuming you're late-binding the Outlook library, the constant olAppointmentItem is not defined, so if you specify Option Explicit at the top of the module the VBE will highlight if as undeclared.

I copied your code into ThisWorkbook in an empty workbook, and ran Rubberduck code inspections (disclaimer: I manage that open-source project; it's completely free, and it's improving every day).

These results are particularly relevant to your problem:

Error: Option Explicit is not specified in 'ThisWorkbook' - (Book3) VBAProject.ThisWorkbook, line 1
Error: Variable 'olAppointmentItem' is used but not assigned - (Book3) VBAProject.ThisWorkbook, line 16
Error: Variable 'olFree' is used but not assigned - (Book3) VBAProject.ThisWorkbook, line 23
Error: Local variable 'olAppointmentItem' is not declared - (Book3) VBAProject.ThisWorkbook, line 16
Error: Local variable 'olFree' is not declared - (Book3) VBAProject.ThisWorkbook, line 23

The underlying value of olFree in the Outlook library is 0 , so that's not a big deal as far as run-time errors are concerned.

However olAppointmentItem not being defined is pretty big: you think you're working against an AppointmentItem object, but because the underlying value of olAppointmentItem in the Outlook library is 1 and you're providing a 0 , the runtime type of olAppItem is actually a MailItem .

And because a MailItem doesn't have a Location property, attempting to set it will raise that run-time error 438 you're getting - "object doesn't support this property or method".

Therefore, you should be creating the olAppItem like this:

Set olAppItem = olApp.CreateItem(1)

Or, define the olAppointmentItem constant:

Const olAppointmentItem As Long = 1
Set olAppItem = olApp.CreateItem(olAppointmentItem)

Or, reference the Outlook object model ( Tools > References... ), replace As Object with the actual types you want to be using ( olApp As Outlook.Application , olAppItem As AppointmentItem ), and then the olAppointmentItem and olFree constants will be taken from the Outlook library.

I'll skip the other inspection results because they're not relevant to that specific question, but you'll notice a number of dead variables there.

Answer 2

If you want to create an appointment in Outlook, using Excel, run the script below.

Private Sub Add_Appointments_To_Outlook_Calendar()

    'Include Microsoft Outlook nn.nn Object Library from Tools -> References
    Dim oAppt As AppointmentItem
    Dim Remind_Time As Double

    i = 2
    Subj = ThisWorkbook.Sheets(1).Cells(i, 1)

    'Loop through entire list of Reminders to be added
    While Subj <> ""
        Set oAppt = Outlook.Application.CreateItem(olAppointmentItem)

        oAppt.Subject = Subj
        oAppt.Location = ThisWorkbook.Sheets(1).Cells(i, 2)
        oAppt.Start = ThisWorkbook.Sheets(1).Cells(i, 3)
        Remind_Time = ThisWorkbook.Sheets(1).Cells(i, 4) * 1 * 60
        oAppt.ReminderMinutesBeforeStart = Remind_Time
        oAppt.AllDayEvent = True
        oAppt.Save

        i = i + 1
        Subj = ThisWorkbook.Sheets(1).Cells(i, 1)
    Wend
    MsgBox "Reminder(s) Added To Outlook Calendar"

End Sub

' The code comes from this link: http://officetricks.com/add-appointment-to-outlook-calendar-through-excel-macro-vba/

The script is run from Excel, and as such, you must set a reference to Outlook before you run the code. Also, notice that the worksheet needs to be setup properly for the script to run. It should look something like this. Everything is read from Excel into Outlook.