Reputation: 69
Title says it all. I wrote the code yesterday and it worked well. I was an idiot and saved incorrectly and lost the code. However, today I rewrote the code to make it happen and I'm not sure why the appointments aren't being created today. The values are properly being stored when I F8 through my Sub. If somebody could point out the hopefully stupid mistake I overlooked, that'd be a lifesaver as I can't find it myself.
Sub test()
Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem, ES As Worksheet, _
r As Long, i As Long, WB As ThisWorkbook
Set WB = ThisWorkbook
Set ES = WB.Sheets("Export Sheet")
r = ES.Cells(Rows.count, 1).End(xlUp).Row
Set OL = New Outlook.Application
For i = 2 To r
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 1).Value
.Start = ES.Cells(i, 2).Value
.End = ES.Cells(i, 3).Value
.Location = ES.Cells(i, 4).Value
.AllDayEvent = ES.Cells(i, 5).Value
.Categories = ES.Cells(i, 6).Value & " Category"
End With
Next i
Set OL = Nothing
End Sub
Upvotes: 3
Views: 20701
Reputation: 1065
There is a working example here
It looks like you are missing .Save
from the end of your loop.
Like this:
For i = 2 To r
Set Appoint = OL.CreateItem(olAppointmentItem)
With Appoint
.Subject = ES.Cells(i, 1).Value
.Start = ES.Cells(i, 2).Value
.End = ES.Cells(i, 3).Value
.Location = ES.Cells(i, 4).Value
.AllDayEvent = ES.Cells(i, 5).Value
.Categories = ES.Cells(i, 6).Value & " Category"
.Save
End With
Next i
Upvotes: 3