CODEWITHSUNDEEP
vbaoutlook
DevonRyder
DevonRyder

Reputation: 193

Create Appointment After Contact has been Saved

I am writing a macro to create an appointment after a contact has been created.

A user can click the button, enter the details for the contact, and once saved, it should open a new appointment window.

The issue is the appointment sub being called before the contact has been saved. Thus, the object/contact does not exist to be passed to the sub.

My code:

' Application-level variables 
Public objOL As Outlook.Application 
Public objNS As Outlook.NameSpace

' Public Folders 
Public objPublicFolderRoot As Outlook.Folder 
Public objCompanyFolder As Outlook.Folder 
Public objContactFolder As Outlook.Folder 
Public objCalFolder As Outlook.Folder

' Set the Public Folders 
Set objPublicFolderRoot = objNS.GetDefaultFolder(olPublicFoldersAllPublicFolders) Set objCompanyFolder = objPublicFolderRoot.Folders("Company_Shared") Set objContactFolder = objCompanyFolder.Folders("Contacts") Set objCalFolder = objCompanyFolder.Folders("Calendars")

Sub CreateEmptyContact()
    Dim objContact As Outlook.ContactItem
    Set objNS = Application.GetNamespace("MAPI")

    ' Build out the contact item
    Set objContact = objContactFolder.Items.Add(olContactItem)

    With objContact
        .Display
    End With

    CreateAppointment(objContact)

    ' Reset vars
    Set objContact = Nothing
    Set objPublicFolderRoot = Nothing
    Set objCompanyFolder = Nothing
    Set objContactFolder = Nothing

End Sub

Public Sub CreateAppointment(objContact As Outlook.ContactItem)   
' Create the appointment on the public folder calendar with the passed contact Public Sub CreateAppointment(objContact As Outlook.ContactItem)
    Dim objCalAppt As Outlook.AppointmentItem
    Set objCalAppt = Application.CreateItem(olAppointmentItem)  

    ' Add to the Appointment to the existing Calendar items
    Set objCalAppt = objCalFolder.Items.Add(olAppointmentItem)
    With objCalAppt
        .MeetingStatus = olNonMeeting 'Not an invitation
        .Start = Now
        .Duration = 120
        .Save
        .Display
    End With

    ' Reset vars
    Set objCalAppt = Nothing   
End Sub

What is my best method moving forward. For example, should I be using something like a WithEvents on the Contact_Send or Contact_AfterWrite?

Upvotes: 0

Views: 80

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66245

You can either show the contact modally (.Display(true)), or you can watch the Items.ItemAdd event on the Contacts folder to fire (after the contact is saved) and use the item passed to your event handler.

Upvotes: 1

Related Questions