Sub Set_Outlook_Reminder()
Dim objOutlook As Object
Dim objAppt As Object
Dim objNamespace As Object
Dim objFolder As Object
Worksheets("Customer Database").Activate
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(9)
Set objAppt = objFolder.Items.Add 'create task item
With objAppt
.Start = DateAdd("m",1,ActiveCell.Value) + TimeValue("08:00:00")
.End = .Start + TimeValue("00:30:00")
.Subject = "Invoice " + ActiveCell.Offset(-2, 0).Value
.Location = ""
.Body = ""
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = 120
.ReminderSet = True
.Save
End With
Set objAppt = Nothing
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing
MsgBox "Successfully Added to Outlook"
End Sub
|