Creating and Sending Outlook Appointment:   Return to List

' Start Outlook.
' If it is already running, you'll use the same instance...
    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
    
' Logon. Doesn't hurt if you are already running and logged on...
    Dim olNs As Outlook.NameSpace
    Set olNs = olApp.GetNamespace("MAPI")
    olNs.Logon

' Create and Open a new contact.
    Dim olItem As Outlook.ContactItem
    Set olItem = olApp.CreateItem(olContactItem)

' Setup Contact information...
    With olItem
     .FullName = "James Smith"
     .Birthday = "9/15/1975"
     .CompanyName = "Microsoft"
     .HomeTelephoneNumber = "704-555-8888"
     .Email1Address = "someone@microsoft.com"
     .JobTitle = "Developer"
     .HomeAddress = "111 Main St." & vbCr & "Charlotte, NC 28226"
    End With
    
' Save Contact...
    olItem.Save
    
' Create a new appointment.
    Dim olAppt As Outlook.AppointmentItem
    Set olAppt = olApp.CreateItem(olAppointmentItem)
    
' Set start time for 2-minutes from now...
    olAppt.Start = Now() + (2# / 24# / 60#)
    
' Setup other appointment information...
    With olAppt
     .Duration = 60
     .Subject = "Meeting to discuss plans..."
     .Body = "Meeting with " & olItem.FullName & " to discuss plans."
     .Location = "Home Office"
     .ReminderMinutesBeforeStart = 1
     .ReminderSet = True
    End With
    
' Save Appointment...
    olAppt.Save
    
' Send a message to your new contact.
    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
' Fill out & send message...
    olMail.To = olItem.Email1Address
    olMail.Subject = "About our meeting..."
    olMail.Body = _
        "Dear " & olItem.FirstName & ", " & vbCr & vbCr & vbTab & _
        "I'll see you in 2 minutes for our meeting!" & vbCr & vbCr & _
        "Btw: I've added you to my contact list."
    olMail.Send
    
' Clean up...
    MsgBox "All done...", vbMsgBoxSetForeground
    olNS.Logoff
    Set olNs = Nothing
    Set olMail = Nothing
    Set olAppt = Nothing
    Set olItem = Nothing
    Set olApp = Nothing



Note to Webmaster