Thread: Exchange 2007 with Outlook 2007

Hi webtekr,

This is the code which i use for deleting appointments in my code,
May this code gives you some idea abut what you are doing.

This is the declarations part.

Code:

Option Compare Database
Option Explicit
'------------------------------------------------------
'   This Access module needs references to:
'
'   Microsoft Outlook [VersionNo] Object Library
'   Microsoft CDO 1.21 Library
'
'   To set references, in the VBA Editor, open the
'   Tools menu and select References.
'------------------------------------------------------
Public mobjOLA As Outlook.Application
Public mobjNS As Outlook.Namespace
Public mobjFLDR As Outlook.MAPIFolder
Public mobjAPPT As Outlook.AppointmentItem

'##CDO (COLLABORATION DATA OBJECTS) VARIABLES##
Public mobjCDOSession As MAPI.Session
Public mobjMAPIAppt As MAPI.Message
Public BolOutlookIS As Boolean

'##PUBLIC VARIABLES FOR SETTING & DELETING APPOINTMENTS##
Public intDateNote As Integer
Public strAppSubject As String
Public dteReccDate As Date
Public tmeSetTime As Date
Public strAppRecr As String
Public strAppLoc As String
Public strAppBody As String
Public intMinutes As Integer
Public strImportance As String
Public bolAllDay As Boolean
Public strBusyStats As String
Public dteStrt As Date
Public dteEnd As Date

Public strAppSubject As String

This is where the details are stored

Code:

Public Sub GetAppDetails()
'--------------------------------------------------------------
'####SET THESE DETAILS TO BE YOUR APPOINTMENT REQUIREMENTS####
'#############################################################
'--------------------------------------------------------------
'##SET THE MEETING LOCATION HERE##
    strAppLoc = "Office"
'--------------------------------------------------------------
'##SET THE RECCURING PERIOD HERE##
    'strAppRecr = olRecursDaily
    'strAppRecr = olRecursWeekly
    strAppRecr = olRecursMonthly
    'strAppRecr = olRecursYearly
'--------------------------------------------------------------
'##SET IF YOU WANT AN ALL DAY APPOINTMENT##
    bolAllDay = True
    'bolAllDay = False
'--------------------------------------------------------------
'##SET THE START & FINISH DATES##
   dteStrt = #19/05/2009#
   dteEnd = #19/05/2009#
'--------------------------------------------------------------
'##SET THE AMOUNT OF MINUTES TO ALERT ON THIS APPOINTMENT##
    intMinutes = "30"
'--------------------------------------------------------------
'##SET THE IMPORTANCE HERE##
    'strImportance = olImportanceLow
    'strImportance = olImportanceNormal
    strImportance = olImportanceHigh
'--------------------------------------------------------------
'##SET THE BUSY STATUS HERE##
        strBusyStats = olBusy
        'strBusyStats = olFree
        'strBusyStats = olOutOfOffice
        'strBusyStats = olTentative
'--------------------------------------------------------------
'##SET THE APPOINTMENT SUBJECT##
    strAppSubject = "Your Message Here!!!"
'--------------------------------------------------------------
'##SET THE BODY TEXT HERE## ( YOU CAN USE  & VbCrlf & _ TO ADD NEW LINES
    strAppBody = "Your first line of the message" & vbCrLf & _
    "Your secong line" & vbCrLf & _
    vbCrLf & _
    "your third Line" & vbCrLf & _
    "Your 4th Line" & vbCrLf & _
    "Your 5th Line" & vbCrLf & _
    "Your 6th Line" & vbCrLf & _
    vbCrLf & _
    "Your eighth Line" & vbCrLf & _
    vbCrLf & _
    "Your ninth Line"

'--------------------------------------------------------------
'####################################################
'--------------------------------------------------------------
End Sub

This code is called when you want to delete the subject

Code:

Public Sub ExampleCall_DeleteBySubject()

    'Collect the details to find
     GetAppDetails

    'Call the Appointment details to find
    Call DeleteAppointmentItemBySubject(strAppSubject)
End Sub

This finds and deletes the appointment based on the subject

Code:

Private Sub DeleteAppointmentItemBySubject(strAppSubject As String)
    '   Use this method ONLY if the subject of the
    '   Appointment Item is known and is UNIQUE.
    Set mobjOLA = CreateObject("Outlook.Application")
    Set mobjNS = mobjOLA.GetNamespace("MAPI")
    mobjNS.Logon , , False, False
    Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)
    On Error Resume Next
    Set mobjAPPT = mobjFLDR.Items(strAppSubject)
    If Err.Number <> 0 Then GoTo CannotFindObject
    mobjAPPT.Delete
    
    MsgBox ("Success!! Your appointment has been deleted")
Bye:
    Set mobjAPPT = Nothing
    Set mobjFLDR = Nothing
    Set mobjNS = Nothing
    Set mobjOLA = Nothing
    Exit Sub
CannotFindObject:
    MsgBox "Cannot find Appointment Item to delete.", _
        vbOKOnly, "Information"
    GoTo Bye
End Sub

This code adds the appointment

Code:

Public Sub AddAppClosedOutlk()
Dim outMail As Outlook.AppointmentItem
Dim strAppStrt As String
Dim strAppEnd As String

'get the user preferences
GetAppDetails

'set the outlook connection
    Set mobjOLA = CreateObject("Outlook.Application")
    Set mobjNS = mobjOLA.GetNamespace("MAPI")
    mobjNS.Logon , , False, False
    Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)
    On Error Resume Next
    Set mobjAPPT = mobjFLDR.Items(strAppSubject)
    
'check for appointment set. if it is, bail and go to bottom
If Err.Number = 0 Then GoTo FoundObject
    
'add the start & end time to the set date
    strAppStrt = dteStrt
    strAppEnd = dteEnd

'collect the user preferences and add to the appointment
    Set outMail = Outlook.CreateItem(olAppointmentItem)
    With outMail
        .Subject = strAppSubject
        .Location = strAppLoc
        .Start = strAppStrt
        .End = strAppEnd
        .GetRecurrencePattern = strAppRecr
        .Body = strAppBody
        .Importance = strImportance
        .AllDayEvent = bolAllDay
        .ReminderMinutesBeforeStart = intMinutes
        .Save
    End With

'show message if appointment is created
    MsgBox ("Success!! Your appointment has been placed")

Bye:

'close the connection
        Set mobjAPPT = Nothing
        Set mobjFLDR = Nothing
        Set mobjNS = Nothing
        Set mobjOLA = Nothing
        Exit Sub
        
'arrive here if the appointment is already set
FoundObject:
    MsgBox "Halt!! Appointment Already Placed!", _
        vbOKOnly, "Information"
    GoTo Bye
End Sub

These are some example codes you just pick which do you want to add.