hello,
I am trying to create multiple appointment items in outlook based on the activesheet in excel. I created this same format when creating task items in outlook and all tasks were created. When i run this code, only the last object is created as an appointment in outlook. Is there soemthign i am missing?
Code
Sub FE_WEDNESDAY()
Dim objOL As Object
Dim objItem As Object
Dim tzCentral As Object
Set objOL = GetObject(, "Outlook.Application")
Set tzCentral = objOL.TimeZones.Item("Central Standard Time")
Set objItem = objOL.CreateItem(1)
intresponse = MsgBox("Do you want to setup " & ActiveSheet.Range("B6") & " reminders?", vbYesNo, "Custom Reminder")
If intresponse = vbYes Then
'7AM
With objItem
.Start = (Date) + ActiveSheet.Range("A8").Value
.StartTimeZone = tzCentral
.Duration = 0
.BusyStatus = olFree
.AllDayEvent = False
.Subject = ActiveSheet.Range("B8").Value
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.Save
End With
'10AM
With objItem
.Start = Date + ActiveSheet.Range("A24").Value
.StartTimeZone = tzCentral
.Duration = 0
.BusyStatus = olFree
.AllDayEvent = False
.Subject = ActiveSheet.Range("B24").Value
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.Save
End With
'1030AM
With objItem
.Start = Date + ActiveSheet.Range("A40").Value
.StartTimeZone = tzCentral
.Duration = 0
.BusyStatus = olFree
.AllDayEvent = False
.Subject = ActiveSheet.Range("B40").Value
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.Save
End With
'11AM
With objItem
.Start = Date + ActiveSheet.Range("A45").Value
.StartTimeZone = tzCentral
.Duration = 0
.BusyStatus = olFree
.AllDayEvent = False
.Subject = ActiveSheet.Range("B45").Value
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.Save
End With
'4PM
With objItem
.Start = Date + ActiveSheet.Range("A52").Value
.StartTimeZone = tzCentral
.Duration = 0
.BusyStatus = olFree
.AllDayEvent = False
.Subject = ActiveSheet.Range("B52").Value
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.Save
End With
'4PM
With objItem
.Start = Date + ActiveSheet.Range("A67").Value
.StartTimeZone = tzCentral
.Duration = 0
.BusyStatus = olFree
.AllDayEvent = False
.Subject = ActiveSheet.Range("B67").Value
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.Save
End With
MsgBox "Your strategy reminders have been created for " & Sheets("Admin Menu").Range("H4"), vbOKOnly, "Strategy Reminder"
ElseIf intresponse = vbNo Then
Exit Sub
Set objItem = Nothing
Set objOL = Nothing
Set tzEastern = Nothing
End If
End SubAm i missing something in between the objects?
Thank you for the help! This is my first post... I always reference to this website for my questions and usually there is an answer to be found.. but i couldnt find anything exact so i joined and am excited to be involved in these forums.