Outlook's Calendar???

This is something I wrote to update calendars, e-mail, and task lists in Outlook. You can put this in a BAS module and call the routines from your form. Of course, you have to reference the Outlook 98 type library. You also need to set up delegates in the Outlook calendars you want to update for the logon you use in the program. Have fun!

Option Explicit

Public OlApp As outlook.Application
Public olNameSpace As outlook.NameSpace
Public olRecipient As outlook.Recipient

Private Sub cmdSendEMail_Click()

Dim olMail As outlook.MailItem

Screen.MousePointer = vbHourglass
Set olMail = OlApp.CreateItem(olMailItem)
olMail.To = "Recipient Name"
olMail.Subject = "Testing out Outlook E-mail"
olMail.Body = "Is it working?"
olMail.Send
Set olMail = Nothing
Screen.MousePointer = vbDefault

End Sub

Private Sub cmdDelEMail_Click()
Dim olMail As outlook.MailItem
Dim strFind As String

Screen.MousePointer = vbHourglass
strFind = "[Subject] = ""Testing out Outlook E-mail"""
Set olRecipient = olNameSpace.CreateRecipient("Recipient Name")
Set olMail = olNameSpace.GetSharedDefaultFolder(olRecipient, olFolderInbox).Items.Find(strFind)
olMail.Delete
Set olMail = Nothing
Screen.MousePointer = vbDefault

End Sub

Private Sub cmdAddTask_Click()

Dim oltask As outlook.TaskItem

Screen.MousePointer = vbHourglass
Set olRecipient = olNameSpace.CreateRecipient("Recipient Name")
Set oltask = olNameSpace.GetSharedDefaultFolder(olRecipient, olFolderTasks).Items.Add
oltask.Categories = "Category"
oltask.Subject = "Testing for task add. Did it work?"
oltask.StartDate = CDate("12/30/99")
oltask.DueDate = CDate("12/31/99")
oltask.Save
Set oltask = Nothing
Screen.MousePointer = vbDefault

End Sub

Private Sub cmdDeleteTask_Click()

Dim strFind As String
Dim oltask As outlook.TaskItem

Screen.MousePointer = vbHourglass
strFind = "[StartDate] = ""12/30/99"" and [DueDate] = ""12/31/99"" and [Categories] = ""Category"""
Set olRecipient = olNameSpace.CreateRecipient("Recipient Name")
Set oltask = olNameSpace.GetSharedDefaultFolder(olRecipient, olFolderTasks).Items.Find(strFind)
oltask.Delete
Set oltask = Nothing
Screen.MousePointer = vbDefault

End Sub

Private Sub cmdAddAppointment_Click()

Dim olappt As outlook.AppointmentItem

Screen.MousePointer = vbHourglass
Set olRecipient = olNameSpace.CreateRecipient("Recipient Name")
Set olappt = olNameSpace.GetSharedDefaultFolder(olRecipient, olFolderCalendar).Items.Add
olappt.Location = "Location"
olappt.Subject = "Test Subject"
olappt.Body = "Testing for calendar add. Did it work?"
olappt.Start = CDate("12/31/00 01:00 AM")
olappt.End = CDate("12/31/00 01:01 AM")
olappt.Save
Set olappt = Nothing
Screen.MousePointer = vbDefault

End Sub

Private Sub cmdDeleteAppointment_Click()

Dim strFind As String
Dim olappt As outlook.AppointmentItem

Screen.MousePointer = vbHourglass
strFind = "[Start] = ""12/31/00 01:00 AM"" and [End] = ""12/31/00 01:01 AM"" and [Subject] = ""Test Subject"""
Set olRecipient = olNameSpace.CreateRecipient("Recipient Name")
Set olappt = olNameSpace.GetSharedDefaultFolder(olRecipient, olFolderCalendar).Items.Find(strFind)
Debug.Print olappt.Start
Debug.Print olappt.End
olappt.Delete
Set olappt = Nothing
Screen.MousePointer = vbDefault

End Sub

Private Sub cmdClose_Click()

Unload Me

End Sub

Private Sub Form_Load()

Set OlApp = New outlook.Application
Screen.MousePointer = vbHourglass
Set olNameSpace = OlApp.GetNamespace("MAPI")
olNameSpace.Logoff
olNameSpace.Logon "Logon Name", "Password", False, True
Screen.MousePointer = vbDefault

End Sub

Private Sub Form_Unload(Cancel As Integer)

olNameSpace.Logoff
Set OlApp = Nothing
Set olNameSpace = Nothing
Set olRecipient = Nothing
Screen.MousePointer = vbDefault

End Sub