How do I run a macro to have a Pop up window msg or Prompt only when I create a meeting from a specific Outlook Calendar (a shared calendar)?

Hi I want to run this macro in VBA outlook (see below) but only in a specific share calendar folder. How do I do that?

The macro works perfectly but as it is, it runs in every calendar that I have on my computer, and I want this prompt only to pop up when I send the meeting from a shared calendar.

 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
   
    Dim olkAppt As Outlook.AppointmentItem
    If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbOK, "Categorize Meeting Request") = vbOK Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
        End If
    End If
    Set olkAppt = Nothing
End Sub

Thanks
MIA AlonsoAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Alexei KuznetsovMicrosoft Outlook MVPCommented:
You can try to check olkAppt's Parent property like this:
If olkAppt.Parent.Name = "SharedCalendarName" Then
...
End If

Open in new window

Be aware that olkAppt.Parent may be Appointment again for recurrent appointments. In this case you need to check olkAppt.IsRecurring property and get olkAppt.Parent.Parent.
0
MIA AlonsoAuthor Commented:
Not working...

The purpose of this is that each time a person creates an appointment in the "Sharedcalendar" before sending the appointment, if they did not include a category, that a meg pop ups and include one category.

With the code above I got the prompt but it also runs when I send an invite from my personal calendar.

With your suggestion when I run the code i got a bug in this line"If olkAppt.Parent.Name = "AAA Calendar".

The structure of my calendar is as shown below:

My Calendar
      Anna
      AAA Calendar

Shared Calendars
      AAA Calendar

And this is the code:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olkAppt As Outlook.AppointmentItem

If olkAppt.Parent.Name = "AAA Calendar" Then
    If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbOK, "Categorize Meeting Request") = vbOK Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
        End If
    End If
    Set olkAppt = Nothing

End If

End Sub
0
Alexei KuznetsovMicrosoft Outlook MVPCommented:
I see. You have the same calendar name. So, you need to check if "AAA Calendar" is the shared calendar. You can do that by checking Store property on olkAppt.Parent like this:
If olkAppt.Parent.Store Is Nothing And olkAppt.Parent.Name = "AAA Calendar" Then
...

Open in new window

0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

MIA AlonsoAuthor Commented:
Thanks thims, it still not working.

It is not that it has the same calendar name, is that I am the full owner of the calendar so I see it in both folders.

This is the bug that I got:
"Run-time error'91':
Object variable or with block variable not set"

To be more precise this is how the folders looks:

My Calendars
      Calendar - anna@...
      Calendar - AAA_Calendar@...

Shared Calendars
      AAA Calendar


This is how the code looks:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olkAppt As Outlook.AppointmentItem

If olkAppt.Parent.Store Is Nothing And olkAppt.Parent.Name = "AAA Calendar" Then
    If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbOK, "Categorize Meeting Request") = vbOK Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
        End If
    End If
    Set olkAppt = Nothing

End If

End Sub
0
Alexei KuznetsovMicrosoft Outlook MVPCommented:
You placed the "If" statement before olkAppt initialization. You need to move it below the "Set olkAppt = ..." line:
If Item.Class = olMeetingRequest Then
    Set olkAppt = Item.GetAssociatedAppointment(False)
    If olkAppt.Parent.Store Is Nothing And olkAppt.Parent.Name = "AAA Calendar" Then
    ...

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MIA AlonsoAuthor Commented:
Thanks thims,
Ok, Now I do not have a bug but when I create the  meeting in the calendar (and purposely do not include the category) the window won't pop up.... and will send the invite without the category.
0
Alexei KuznetsovMicrosoft Outlook MVPCommented:
Maybe your calendar name is not exactly "AAA Calendar". To find its name, you can insert this line:
If Item.Class = olMeetingRequest Then
    Set olkAppt = Item.GetAssociatedAppointment(False)
    MsgBox olkAppt.Parent.Name
    ...

Open in new window

This will show the message box with exact calendar name. Use this name instead of "AAA Calendar".
0
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.