Last reviewed on June 26, 2015   —  61 Comments

An Outlook Calendar owner wanted to know how to notify a delegate that a new appointment was scheduled when adding an appointment to the calendar. Solution: VBA that watches for a new appointment item and sends an email to a predetermined email address.

Generate an email when you create an appointment

To avoid sending email for personal appointments, the VBA looks for a category named "private" and only sends an email if that category is NOT assigned to the appointment. You could use a subject filter to check for the word Private as the first word in the subject instead:

If Item.Class = olAppointment And _ 
    Left(Item.Subject, 8) <> "Private:" Then 

With a little tweaking, the delegate could generate the email to the boss when she adds a new appointment to the boss's calendar.

Send an Email when a New Appointment is added to Calendar

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  On Error Resume Next

If Item.Class = olAppointment And _
   Item.Categories <> "private" Then

  Dim objMsg As MailItem
   Set objMsg = Application.CreateItem(olMailItem)

   objMsg.To = "alias@domain.com"
   objMsg.Subject = Item.Subject
   objMsg.Body = "New appointment added to " & Item.Organizer & "'s calendar." & _
     vbCrLf & "Subject: " & Item.Subject & "     Location: " & Item.Location & _
     vbCrLf & "Date and time: " & Item.Start & "     Until: " & Item.End
   
'use Display instead of Send if you want to add a note before sending
   objMsg.Send

   Set objMsg = Nothing

   End If

End Sub

Watching for new items in a non-default calendars

If the calendar is not your default calendar, you need to use the Function for non-default folders at Working with VBA and non-default Outlook Folders.

After adding the GetFolderPath function to the module, change
Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
to
Set Items = GetFolderPath("other-datafile-display-name\Calendar").Items

Don't forget to change the display name to the name that is used in the folder list.

Watch for new appointments in a Shared Calendar

To watch for updates in a shared calendar (Exchange Server), you need to resolve the recipient and use GetSharedDefaultFolder. Replace the Application_Startup macro with this, using the shared mailbox's display name as it appears in the GAL.

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim CalendarFolder As Outlook.Folder
  Dim objOwner As Outlook.Recipient
  
  Set Ns = Application.GetNamespace("MAPI")
  Set objOwner = Ns.CreateRecipient("Mary Contrary")
    objOwner.Resolve
     
 'MsgBox objOwner.Name

 If objOwner.Resolved Then

  Set CalendarFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderCalendar)
  Set Items = CalendarFolder.Items
 End If

End Sub

Watch for Updates

To watch for updates, you'll use the same code in a procedure named Private Sub Items_ItemChange(ByVal Item As Object). If you are watch for new or updated items, add this code to the module after the ItemAdd code above. If you are only watching for the ItemChange event, you need to use the Application_Startup and declaration code from above. (Or use the code above and change ItemAdd to ItemChange.)


Private Sub Items_ItemChange(ByVal Item As Object)
  On Error Resume Next
 
If Item.Class = olAppointment Then
 
  Dim objMsg As MailItem
   Set objMsg = Application.CreateItem(olMailItem)
 
   objMsg.To = "alias"
   objMsg.Subject = Item.Subject
   objMsg.Body = "Appointment changed " & Item.Organizer & "'s calendar." & _
     vbCrLf & "Subject: " & Item.Subject & "     Location: " & Item.Location & _
     vbCrLf & "Date and time: " & Item.Start & "     Until: " & Item.End
    
'use Display instead of Send if you want to add a note before sending
   objMsg.Display
 
   Set objMsg = Nothing
 
   End If
 
End Sub

Send message from Creator

If you have multiple users sharing the same calendar and set the macro up for each user, when the new calendar event syncs to each computer, multiple messages will be generated. To prevent this, use a properyaccessor to get the account name that created the appointment and compare it to the default email account name. If they match, generate the message.

This code watches the user's default calendar. See Working with VBA and non-default Outlook Folders if you need to watch a different calendar.


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  'On Error Resume Next

Dim CreatedByName 'As String
Dim pa As Outlook.propertyAccessor
Set olns = Application.GetNamespace("MAPI")
Set pa = Item.propertyAccessor
CreatedByName = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3FFA001E")

If CreatedByName = olns.Accounts.Item(1) Then


'If Item.Class = olAppointment And _
   Item.Categories <> "private" Then
 
  Dim objMsg As MailItem
   Set objMsg = Application.CreateItem(olMailItem)
 
   objMsg.To = "alias@domain.com"
   objMsg.Subject = Item.Subject
   objMsg.Body = "New appointment added to " & Item.Organizer & "'s calendar." & "By " & CreatedByName & _
     vbCrLf & "Subject: " & Item.Subject & "     Location: " & Item.Location & _
     vbCrLf & "Date and time: " & Item.Start & "     Until: " & Item.End
'use Display instead of Send if you want to add a note before sending
   objMsg.Display 'Send
 
   Set objMsg = Nothing
 
   End If
' End If
 Set olns = Nothing
End Sub


Discuss in our community

Comments

    • Diane Poremsky says

      Do you get any error messages?
      Do you have macro security set to low?
      Did you restart Outlook or click in the Application Startup macro and click the Run button?

  1. Joseph says

    How can I get this to work with a script in the rules? I want an email automatically sent to the sender with a message in the body of my email only when I have a calendar event set to "Out of Office" during the time the email was sent to me.

    Thanks!

    • Diane Poremsky says

      You can. You need to watch for delete and update events. Copy the ItemAdd macro and change the name of the copy to
      Private Sub Items_ItemChange(ByVal Item As Object)

      Using ItemRemove is a bit trickier (and isn't working for me tonight.) Same code, macro goes in a class module and is named Public Sub Items_ItemRemove() and you need a handler -

      Public Sub Initialize_handler()
      Set Items = Application.GetDefaultFolder(olFolderCalendar).Items
      End Sub

  2. Josh says

    Thanks Diane. I was able to make the ItemChange function work, but it is sending three emails for every change. Thoughts? Note: This is not my default calendar. It is a secondary calendar that I have shared.

    • Elizabeth says

      I am having the same issues as Josh with three e-mails for ItemChange. Here's the code I'm using:

      Private WithEvents Items As Outlook.Items

      Private Sub Application_Startup()
      Dim Ns As Outlook.NameSpace
      Set Ns = Application.GetNamespace("MAPI")
      Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
      End Sub
      Private Sub Items_ItemAdd(ByVal Item As Object)
      On Error Resume Next

      If Item.Class = olAppointment And _
      Item.Categories "Private" Then

      Dim objMsg As MailItem
      Set objMsg = Application.CreateItem(olMailItem)

      objMsg.To = "boss1@job.com"
      objMsg.CC = "boss2@job.com"
      objMsg.Subject = "Appointment Added to " & Item.Organizer & "'s Calendar."
      objMsg.Body = "A new appointment has been added to " & Item.Organizer & "'s calendar." & _
      vbCrLf & "Subject: " & Item.Subject & " " & _
      vbCrLf & "Location: " & Item.Location & " " & _
      vbCrLf & "Date and time: " & Item.Start & " until " & Item.End

      objMsg.Display

      Set objMsg = Nothing

      End If

      End Sub

      Private Sub Items_ItemChange(ByVal Item As Object)
      On Error Resume Next

      If Item.Class = olAppointment And _
      Item.Categories "Private" Then

      Dim objMsg As MailItem
      Set objMsg = Application.CreateItem(olMailItem)

      objMsg.To = "boss1@job.com"
      objMsg.CC = "boss2@job.com"
      objMsg.Subject = "Appointment Changed on " & Item.Organizer & "'s Calendar."
      objMsg.Body = "An existing appointment has been changed on " & Item.Organizer & "'s calendar." & _
      vbCrLf & "Subject: " & Item.Subject & " " & _
      vbCrLf & "Location: " & Item.Location & " " & _
      vbCrLf & "Date and time: " & Item.Start & " until " & Item.End

      objMsg.Display

      Set objMsg = Nothing

      End If

      End Sub

      -----
      Any ideas what is causing this? I really don't want to bombard my bosses with three e-mails every time I move my own appointments around, though obviously I'd like to notify them when my schedule changes. I've got it set to Display for now, so I am avoiding that, but I'd like to change it to Send eventually so it just happens without me thinking about it.

      Additional Questions:
      How can I set additional categories not to fire an e-mail? For example, my category for Bills. I just don't know the coding. Do I use commas or a separate line?

      I also have appointments scheduled on the weekends, which my bosses don't need to be notified of. Is there a way to limit e-mails to those appointments scheduled during my set working hours?

      Thank you for your assistance!

    • Diane Poremsky says

      I figured this out the other day, at least for marking tasks complete. It should apply to appointments too, although I'm not sure if the fix will work the same. When cached mode syncs changes every 20~ seconds, it sees the item on the server was changed and runs the macro on the item as it syncs, even though it was already run. I'll see if the task solution might work here.

  3. Mike says

    Hello Diane. Thanks for the code. However, I am struggling to get the If... Then statement to filter correctly. I would like an email sent only when the new appointment has a certain category set. I'm using this code:-

    If Item.Class = olAppointment And Items.Categories = "Book" Then

    Unfortunately, the script sends an email regardless of the category set.

    Any ideas?
    Thanks!

    • Diane Poremsky says

      Also, the category name is case sensitive - I assume the category name is Book with a capital B, so you can consider this just an FYI and a warning for others who might use lower case in the code.

  4. Mike says

    Thank you for the swift reply. Using Item.Categories the code works. I've run into a slightly different problem. If the appointment has more than one category assigned to it e.g. Book and Internal then it seems that the script ignores it. Is this right and is there a way to send an email for any appointment that has the "Book" category set?

    The If ... then statement I'm using looks like this:-

    If Item.Class = olAppointment And Item.Categories = "Book" Then

    Thanks in advance.
    Mike

    • Diane Poremsky says

      Categories is a string, and the entire string is checked - if you use multi categories, you need to check for parts of the string, using Instr:

      InStr(Item.Categories, "Book")

  5. Austin Knobloch says

    I am having trouble getting this implemented. I added this code as a "Class Module," but when I add an event nothing happens...Any help would be appreciated!

    • Diane Poremsky says

      Do you have macro security set to low? Is the application startup macro in thisoutlooksession? That is a requirement. (You'll need to change the folder you're watching in application_startup too.)

  6. Austin says

    I guess I should of stated my goal. I have a Public Calendar in the Public Folders that I want to get email notifications when anything is added or changed.
    thanks.

  7. Lori says

    Hello Diane, I am not a developer and concerned with inputting code that I'm not familiar with. I am wondering if you can help a novice set this up so any time I add a "personal" calendar item to my "personal" Outlook calendar, either via iphone/ipad/laptop, it automatically sends an email to my work email address. More and more I want to keep work and personal separate. This way I can create a separate personal calendar at work, from the emails I would send myself, which no one has access to, and overlay it with my work calendar to identify any conflicts, etc. Perhaps if you can tell me which elements in the code above need to be customized, I can do this myself.

    • Diane Poremsky says

      The macro under Send an Email when a New Appointment is added to Calendar is all you need - if you are going to send the email for all appointments, change
      If Item.Class = olAppointment And _
      Item.Categories <> "private" Then
      to
      If Item.Class = olAppointment Then

      and of course, enter the address you want the appt sent to. When you create an appt on a smartphone, the email won't be generated until the device syncs with Outlook. And outlook needs to be open for the macro to work.

  8. yodelayheewho says

    Diane,
    I tried to run the macro (below) and I got this message: "The macros in this project are disabled. Please refer to online help or documentation of the host application to determine how to enable macros."

    I found a tip on the Internet suggesting I digitally sign the macro. So, I did. I closed Outlook 2013 and opened it again. And got the message above.

    My Macro Settings in the Trust Center are: "Notifications for digitally signed macros, all other macros disabled."

    Another tip was to change the Macro Settings in the Trust Center to: "Enable all macros..." I am not comfortable with this as it may be 'potentially dangerous'.

    Here's the code I have:

    Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
    End Sub
    Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    objMsg.To = "work email address here"
    objMsg.Subject = Item.Subject
    objMsg.Body = "New appointment added to My personal calendar" & Item.Organizer & "My work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Private Sub Items_ItemChange(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    objMsg.To = "work email address here"
    objMsg.Subject = Item.Subject
    objMsg.Body = "Appointment changed on My personal calendar" & Item.Organizer & "My work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Any suggestions?

    • Diane Poremsky says

      Hmmm. I decided i need to redo the video and guess what... I'm getting the same message on a signed macro. :(

    • Diane Poremsky says

      Ok... not sure what fixed it, installing waiting updates or publishing the certificate in Trusted root, then Trusting it when the dialog comes up when restarting outlook. It also works to restart Outlook using Run as Admin once, so you can accept the certificate.

  9. yodelayheewho says

    Diane,

    Now, when I close and reopen Outlook 2013, I get the following message:
    "This file contains macros with an expired or revoked signature. Since you are running under High Security Level, these macros will be disabled."

    • Diane Poremsky says

      For testing you need to use low security, then when the macro is finished, sign it and set security to signed only. The reason for this is because every time you change the macro, you need to re-sign it.

  10. Lauren says

    Diane,

    I can't get it to work at all for whatever reason. I don't have the option to "run" after I input the code in a module. Suggestions?

    Thanks!

  11. Darryl says

    Diane,

    I have copied and pasted the script into ThisOutlookSession and when I click the save button and then try to run it, it pulls up the Macros box and there is nothing to select to run. What am I missing here? This is my first time working with scripts. Thank you.

    • Diane Poremsky says

      Its an application start macro. Click in the application start macro and click run or restart outlook to start it. Macros with 'sub name (something here)' format are called by other macros.

  12. saju says

    Hi Diane

    Is there a way to get notified by email whenever a change is made in a shared calendar by some one else? I understand that the above codes are for sending emails to others when one tries to create a new appointment or updates an already existing appointment in a shared calendar.

    • Diane Poremsky says

      You can use the code with a shared calendar, provided the calendar was in your Outlook profile. It should run when it detects a new item in the calendar (if you set it to watch the correct calendar), although I'm not sure it will detect changes to events.

  13. yodelayheewho says

    Hi Diane,

    I finally was able to hit 'run' and get no error messages for the following code (I substituted my work email address and my name with the word "alias").

    I ran a test, creating an appointment in Outlook 2013 on my home PC laptop with my work PC laptop next to me, with Outlook 2010 open. I never received an email notifying me that I scheduled an appointment on my home PC:(

    I feel like I'm so close to solving this. What am I missing?

    Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
    End Sub
    Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    objMsg.To = "alias"
    objMsg.Subject = Item.Subject
    objMsg.Body = "New appointment added to alias's personal calendar" & Item.Organizer & "alias's work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Private Sub Items_ItemChange(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

    Dim objMsg As MailItem
    Set objMsg = Application.CreateItem(olMailItem)

    objMsg.To = "alias"
    objMsg.Subject = Item.Subject
    objMsg.Body = "Appointment changed on alias's personal calendar" & Item.Organizer & "alias's work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Sub HomeCalendarEMailedToWorkCalendar()

    End Sub

    • Diane Poremsky says

      change the objmsg.send line to objmsg.display - see if the message opens on screen.
      Not sure what this is supposed to do:
      Sub HomeCalendarEMailedToWorkCalendar()

      End Sub

      but the reset of the code looks good. Well, except for the missing first line: Private WithEvents Items As Outlook.Items. With that added, the code works here.

  14. yodelayheewho says

    Hi Diane,

    I changed the objmsg.send line to objmsg.display.

    Then, when I add Private WithEvents Items As Outlook.Items to the very first line. It turns red and I get the following error message: "Compile error: Only valid in object module".

    I click ok to get rid of the error message.

    When I try to click Run, then the macro dialog box pops up asking me to name the macro. So, I named it: HomeCalendarEMailedToWorkCalendar and it places the following underneath all of the code:

    Sub HomeCalendarEMailedToWorkCalendar()

    End Sub

  15. Jami Backer says

    I'm currently using this code and it's working beautifully. I do however wonder if there is more code to add that would make the notification email appear in red. Thanks!

    • Diane Poremsky says

      If you want it to show up in your message list in red, make it past due. However, outlook can make this difficult and remove past due reminders - if so add a flag for follow up text and make a conditional rule to display messages with this flag in color
      objMsg.FlagRequest = "Appointment added to calendar"

      past due code is objMsg.TaskDueDate = Now - 1

  16. hello123 says

    I am not able to run the code "Send an Email when a New Appointment is added to Calendar". It says error in the first line at "private WithEvents.......". Could anyone solve this issue since its quite urgent.

  17. Chris says

    Brilliant.

    A "me too" on the sending three times on update.

    I tweaked the original to send as vcs file, so can be accepted by my gmail calendar

    Private Sub Items_ItemAdd(ByVal Item As Object)
    Dim oForward As MailItem

    If TypeName(Item) = "AppointmentItem" Then
    'Forward the appointment
    Set oForward = Item.ForwardAsVcal
    oForward.Recipients.Add ("bob@gmail.com")

    'Send it
    oForward.Send
    Set oForward = Nothing
    End If

    • Diane Poremsky says

      An exchange account will create up to 3 items under certain circumstances (like macros that create a new item when one is updated) - it's due to syncing updates. Using the entryid for the item that triggers it works as does adding a category and using an if statement that looks for any category but that one. I'll see if i can get this one to repro and see if the entryid solution fixes it.

    • Chris says

      Many thanks, alas, not "official" work, so I can't dig too deep. Just trying to get my work appointments on personal phone as we are about to switch off "unmanaged" access

  18. Carl says

    Hi Diane!

    Is there any way I can get you to walk my through what you mean by using the entryid to avoid the 3 email issue with exchange? I would really appreciate it. Here is my code for the ItemChange

    Private Sub ItemsLrg_ItemChange(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

    Dim iD As String
    iD = Item.EntryID

    Dim objMsg As MailItem
    Set objMsg = Application.Session.GetItemFromID(iD)

    objMsg.To = "someone@work.com"
    objMsg.Subject = "Large Conference Room Appointment Modified"
    objMsg.Body = "Appointment changed " & Item.Organizer & "'s calendar." & _
    vbCrLf & "Subject: " & Item.Subject & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    objMsg.Display

    Set objMsg = Nothing

    End If

    End Sub

    Set this way I no longer get 3 emails when the appoint is first made but I also do not get any messages when the appointment is changed.

    If I have my code setup like your initial code shows above I get the 3 emails when creating or modifying an appointment.

    I am not too familiar with VBA as I am mainly java and c#

    Also can you direct me to a good API resource for VBA? I am trying to get an email setup when someone deletes an appointment as well.

    Thank you so much for these procedures they helped me in finding a solution I have been working on :).

    • Carl says

      Hi DIane!,

      Thank you for the speedy reply I very much appreciate it. So I ran the changes you suggested as shown:

      Dim strID As String
      Dim objMsg As MailItem
      strID = Item.EntryID
      Set objMsg = Application.Session.GetItemFromID(strID)

      However I am getting a runtime error '13' Type mismatch at the line:
      Set objMsg = Application.Session.GetItemFromID(strID)

      This occurs during the next sync cycle from the exchange server after I add an event to the calendar and receive the initial email for appt made.

      I tried a few datatype changes to fix the issue but would get other errors.

      If it matters I am running Outlook 2010 and Exchange server 2010. I apologize if this is a trivial error but don't seem to have a lot of luck finding specific solutions on other sites.

      Thanks again!

  19. Carl says

    So I am pretty sure I know what is going on. In this code I am attempting to use the EntryID from a incoming AppointmentItem Object and set it to my newly created MailItem Object which is why I am getting a type mismatch. I can create a new AppointmentItem and set the EntryID of the Incoming "Item" Object to that variable but I am unsure how I set up the test as I am really not sure what this is accomplishing. I assume that I am testing to see if the EntryID is the same as it was when created indicating nothing has changed so there is no need to send an email. Only if the EntryID is different (Which I assume would indicate a change to the appointment) would I need to send an email.

    Does this make sense? Or am I totally off on the logic of the code?

    Thanks again Diane

  20. danielg27 says

    Hi Diane,

    How can I use this to constantly monitor a shared calendar? As I understand, this will only work if the Outlook client is open. Is there a way to constantly monitor a shared calendar if new items are added to it?

    Thanks in advance!

    • Diane PoremskyDiane Poremsky says

      Yes, you would need Outlook open to use a macro to monitor the shared folder (or any folder) using VBA. You can't monitor the folder when Outlook is closed - doing so would require scripts running on the server and the administrator would need to set it up.

  21. Michael Fitzpatrick says

    Hi Diane,

    I have to code working to send an email when a New Appointment is added to a 'Shared Mailbox' Calendar as described. I have multiple people who will need to add appointments to this calendar. I have the macro code setup on each of their Outlook clients. the problem is that when anyone add a new appointment, an email is sent from all the users.

    How can this be configured so that the only email is sent is from the user who added the appointment?

    Thanks.

    • Diane PoremskyDiane Poremsky says

      I think the best method is to check for the organizer and if the organizer is your account, send it.

    • Diane PoremskyDiane Poremsky says

      Try adding this code above the if line -

      Dim CreatedByName 'As String
      Dim pa As Outlook.propertyAccessor
      Set olns = Application.GetNamespace("MAPI")
      Set pa = Item.propertyAccessor
      CreatedByName = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3FFA001E")
      If CreatedByName = olns.Accounts.Item(1) Then

      (and another end if at the end)

    • Michael Fitzpatrick says

      Hi Diane, I tried to post this a few days ago, but it has disappeared...

      I cannot seem to get this additional code to only 'Send message from Creator' to work. Now nothing happens when I add a calendar entry. Can you confirm the code works? There seems to be a few differences between what is here in your March 11 post, versus what's further up in the 'Send Message from Creator' page section with the full code. Some code is commented out.

      Any assistance will be appreciated, thanks.

    • Diane PoremskyDiane Poremsky says

      I assume you mean this commented out line - that just removes watching for the appointment class. Since you are watching the calendar, you don't really need to check the type.
      If CreatedByName = olns.Accounts.Item(1) Then
      'If Item.Class = olAppointment And _
      Item.Categories <> "private" Then

      Are you using this from the first macro? You need these lines from the first one - the later macros on the page just replace the itemadd macro.

      Private WithEvents Items As Outlook.Items

      Private Sub Application_Startup()
      Dim Ns As Outlook.NameSpace
      Set Ns = Application.GetNamespace("MAPI")
      Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
      End Sub

    • Michael Fitzpatrick says

      Hi again Diane,

      I'm still trying to get this to work. I am almost there. I am selecting the shared calendar Event Scheduler in the Application Startup and this works fine. I believe the problem for me is in my Items_Add code definitions. If I comment out the "If CreatedByName = olns.Accounts.Item(1) Then", the email does get sent in my tests and does have my name as the CreatedByName. What am I missing here? Is it in the Set olns= somewhere? (I changed my email address in this post).

      I really need to get this to work!.
      Thanks so much, Michael.

      Private WithEvents Items As Outlook.Items

      Private Sub Application_Startup()
      Dim Ns As Outlook.NameSpace
      Dim CalendarFolder As Outlook.Folder
      Dim objOwner As Outlook.Recipient

      Set Ns = Application.GetNamespace("MAPI")
      Set objOwner = Ns.CreateRecipient("Event Scheduler")
      objOwner.Resolve

      MsgBox objOwner.Name

      If objOwner.Resolved Then

      Set CalendarFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderCalendar)
      Set Items = CalendarFolder.Items
      End If

      End Sub

      Private Sub Items_ItemAdd(ByVal Item As Object)
      'On Error Resume Next

      Dim CreatedByName 'As String
      Dim pa As Outlook.PropertyAccessor
      Set olns = Application.GetNamespace("MAPI")
      Set pa = Item.PropertyAccessor
      CreatedByName = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3FFA001E")

      If CreatedByName = olns.Accounts.Item(1) Then

      'If Item.Class = olAppointment And _
      Item.Categories "private" Then

      Dim objMsg As MailItem
      Set objMsg = Application.CreateItem(olMailItem)

      objMsg.To = "EventAdmins@company.com"
      objMsg.Subject = Item.Subject
      objMsg.Body = "New appointment added to " & Item.Organizer & "'s calendar " & "by " & CreatedByName & _
      vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
      vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End
      'use Display instead of Send if you want to add a note before sending
      objMsg.Send 'Display

      Set objMsg = Nothing

      ' End If
      End If
      Set olns = Nothing
      End Sub

    • Diane PoremskyDiane Poremsky says

      I think the problem is that olns.Accounts.Item(1) is getting your email address (the account display name) but createdby is using your display name from the AD.

      There is a way to update the account name to a display name, but it would probably be better to lookup the account's display name.

  22. Paul C. says

    How do I get this macro to run all the time? Right now I have created the macro using your code (thanks!) but when I create a calendar appointment no email goes out. Am I missing something?

  23. David Eisinger says

    Will this work for group calendar? Can specific people be notified by email when updating a shared or group calendar?

    • Diane PoremskyDiane Poremsky says

      yes, provided its open in someone's profile. id its in a shared mailbox, replace the application startup macro with the one under Watch for new appointments in a Shared Calendar.

  24. Andy Knapper says

    Hi
    Would this be able to be run at a specific time for a specific period?
    My boss likes to know what days i'm out of the office for the upcoming week, so could this be set to run on a Friday with all appointments that are tagged "out of office" for the next seven days?

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

If the Post Comment button disappears, press your Tab key.