Outlook Calendar 2007 - Invitation Times

Status
Not open for further replies.

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi,

Is there a vba script that will pop up when a meeting is scheduled at incorrect times say after 6:00pm and before 7:00am?

I am using Windows 7, and Office 2007 as well.

Any assistance is appreciated.

Thank youl:confused:
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi Diane,

Thank you for your quick response. I tried it and it gives me an error message "Compile error: Only valid in object module". It highlights the "WithEvents" in blue. When I try to Run it, it opens up the Macros box for a name creation, etc.

I seem to be doing everything listed in your thread. Since I am a real Rookie :), could you please simplify it for me, do I paste the entire script or do I remove the green line 'change the start time...'. I tried with both and neither seem to work. Can you please help?

Thank you.
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi again,

I have good news and bad news :) :(

I think I had to close Outlook to work - and it did! So the vba works great. An appointment scheduled out of the specified times sends a popup alert.

However, if I take an existing message and change the start or end times to a time out of the eligible times, it does not send the alert. The second issue is it is sends a popup for any invitation starting before 8:00. Is this because of the GMT or local times? I am in the PST time zone.

Thank you for all your help.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
The macro only looks for items added, not items changed. I'll have to test it to be sure, but I think you need to add these lines at the top

Public WithEvents OlItems As Outlook.Items

Public Sub Initialize_handler()
Set OlItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderCalendar).Items

End Sub

Copy the ItemAdd macro and change the first line to this -

Private Sub OlItems_ItemChange(ByVal Item As Object)

(I'll test it and add it to the webpage.)

The code is time zone insensitive - these lines control the times it checks. It should look ofr appt before 8 AM or that end after 7 PM. Edit the times as needed. If you want to check the start time instead of the end time, change item.end to item.start

If TimeValue(Item.Start) < TimeValue("7:59:00 AM") Or _
TimeValue(Item.End) > TimeValue("7:00:00 PM") Then
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I did some quick tests - copy the application_startup, paste the copy under the current startup marco. Copy the itemadd macro and paste under the current itemadd.

Replace the first line (sub name line) of application_startup with

Public Sub Initialize_handler()

and replace the itemadd first line with

Private Sub Items_ItemAdd(ByVal Item As Object)

It's a little cleaner than using two different variable names (but that works too).
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi Diane,

I did the edits as suggested and it still does not work for a revised appointment. To make it easy please look at the attached file.

I tried to upload a Word document with the script and I received an error about the file not being compatible. When I made a .pdf it exceeded the byte space, so here is the script that I am using.

New Script


Private WithEvents Items As Outlook.Items

Public Sub Initialize_handler()

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

' change the start and end times as needed

If TimeValue(Item.Start) < TimeValue("6:59:00 AM") Or _

TimeValue(Item.End) > TimeValue("4:59:00 PM") Then

strMsg = "This appointment is scheduled to start at " & _

vbCrLf & TimeValue(Item.Start) & " and end at " & _

TimeValue(Item.End) & vbCrLf & _

"Do you still want to schedule it?"

intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours")

' If you say no, the opens for you to change the times or delete it.

If intRes = vbNo Then
Item.Display

End If

End If

End Sub

To make it easy for me, could you please send me a single correct script.

Thanks,

Outlook Rookie for sure! :)
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hello again,

Can you pls check the script to offer the prompt for revised bookings as well.

Thank you.
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi.

Could someone please update the script to include the prompt for existing bookings as well. Please, please, please?

Thank you.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I did some quick tests - copy the application_startup, paste the copy under the current startup marco. Copy the itemadd macro and paste under the current itemadd.




Replace the first line (sub name line) of application_startup with




Public Sub Initialize_handler()


and replace the itemadd first line with




Private Sub Items_ItemAdd(ByVal Item As Object)




It's a little cleaner than using two different variable names (but that works too).





There is a typo in this (sorry about that) - it should be




Private Sub Items_ItemChange(ByVal Item As Object)




You need both the original macros for new items and also a copy for the item change. This should work -




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




Private Sub Items_ItemChange(ByVal Item As Object)
On Error Resume Next
' change the start and end times as needed
If TimeValue(Item.Start) < TimeValue("6:59:00 AM") Or _
TimeValue(Item.End) > TimeValue("4:59:00 PM") Then
strMsg = "This appointment is scheduled to start at " & _
vbCrLf & TimeValue(Item.Start) & " and end at " & _
TimeValue(Item.End) & vbCrLf & _
"Do you still want to schedule it?"
intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours")
' If you say no, the opens for you to change the times or delete it.
If intRes = vbNo Then
Item.Display
End If
End If
End Sub
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
I tried the new script and it does not work at all. Even new bookings can be scheduled without the popup alert. This time I logged off completely and it still did not work.
:(
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
What is your macro security setting? Did you click in the application Startup macro and click run to kick start it? Do you get any error messages?

If you get error messages - you need to DIM the two variables -

After On Error Resume Next, add
Dim strMsg As String
Dim intRes
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Thank you for your support in still trying to help me. The macro security settings are set to “Warning for all macros” by default and this cannot be changed. There are no error messages received with any scripts including the latest script. I found the original script and tested it again and it works fine ONLY for new invitations and not for revised invitations. So here below is what I currently have which works for new invitations, which is followed by the latest script which does not work for new or existing invitations. Can you please see where the fix is needed and send me the corrected script.

Thank you again.

Script that works for NEW invitations


Private WithEvents Items As Outlook.Items

Public Sub Initialize_handler()

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

' change the start and end times as needed

If TimeValue(Item.Start) < TimeValue("6:59:00 AM") Or _

TimeValue(Item.End) > TimeValue("4:59:00 PM") Then

strMsg = "This appointment is scheduled to start at " & _

vbCrLf & TimeValue(Item.Start) & " and end at " & _

TimeValue(Item.End) & vbCrLf & _

"Do you still want to schedule it?"

intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours")

' If you say no, the opens for you to change the times or delete it.

If intRes = vbNo Then
Item.Display

End If

End If

End Sub

Script that does not work for new or existing invitations

Public Sub Initialize_handler()

Dim Ns As Outlook.NameSpace

Set Ns = Application.GetNamespace("MAPI")

Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items

End Sub

Private Sub Items_ItemChange(ByVal Item As Object)

On Error Resume Next

' change the start and end times as needed

If TimeValue(Item.Start) < TimeValue("6:59:00 AM") Or _

TimeValue(Item.End) > TimeValue("4:59:00 PM") Then

strMsg = "This appointment is scheduled to start at " & _

vbCrLf & TimeValue(Item.Start) & " and end at " & _

TimeValue(Item.End) & vbCrLf & _

"Do you still want to schedule it?"

intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours")

' If you say no, the opens for you to change the times or delete it.

If intRes = vbNo Then

Item.Display

End If

End If

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
The first

Public Sub Initialize_handler()

should be Private Sub Application_Startup()

Although if item add works with initialize handler, both should.

This works for changed items here - you need to add the 2 Dim's to avoid errors. If you aren't getting an object error, then the macro isn't even running - try clicking in the initialize hander macro and clicking Run.

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

Dim strMsg As String
Dim intRes

' change the start and end times as needed
If TimeValue(Item.Start) < TimeValue("6:59:00 AM") Or _
TimeValue(Item.End) > TimeValue("4:59:00 PM") Then
strMsg = "This appointment is scheduled to start at " & _
vbCrLf & TimeValue(Item.Start) & " and end at " & _
TimeValue(Item.End) & vbCrLf & _
"Do you still want to schedule it?"
intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours")
' If you say no, the opens for you to change the times or delete it.
If intRes = vbNo Then
Item.Display
End If
End If
End Sub
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi

I tried the last script with the changes and it does not work either for new or for existing invites. I have clicked the Run as well as Debug and do not get an error. However, I pasted the original script again and it worked fine ONLY for new messages. I also have other macros that are working well.

Thank you for you help.

Have a good Christmas and Holiday Season. Perhaps Santa will work his magic and make this macro work. That would be the best Christmas present ever!
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Happy New Year to all at this Forum!

Do you have an update?

Thank you.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This works with appointments and edited appointments as well as meeting and meeting updates.






Code:

 
 

 
 
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
 
 

 
 

Public Sub Initialize_handler()
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

 
 
' change the start and end times as needed
 
 
If TimeValue(Item.Start) < TimeValue("7:59:00 AM") Or _
   TimeValue(Item.End) > TimeValue("7:00:00 PM") Then
    
   strMsg = "This appointment is scheduled to start at " & _
   vbCrLf & TimeValue(Item.Start) & " and end at " & _
   TimeValue(Item.End) & vbCrLf & _
   "Do you still want to schedule it?"
   intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours")
    
 
 
' If you say no, the opens for you to change the times or delete it.
   If intRes = vbNo Then
     Item.Display
   End If
    
 
 
End If
 
 
 
End Sub
 
 

 
 

Private Sub Items_ItemChange(ByVal Item As Object)
On Error Resume Next
' change the start and end times as needed 
If TimeValue(Item.Start) < TimeValue("6:59:00 AM") Or _ 
TimeValue(Item.End) > TimeValue("4:59:00 PM") Then
strMsg = "This appointment is scheduled to start at " & _ 
vbCrLf & TimeValue(Item.Start) & " and end at " & _ 
TimeValue(Item.End) & vbCrLf & _ 
"Do you still want to schedule it?"
intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Confirm Appointment Hours") 
' If you say no, the opens for you to change the times or delete it. 
If intRes = vbNo Then
Item.Display 
End If
End If
End Sub
 

Outlook Rookie

Senior Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi Diane,

This works great - for new and existing invitations. Thank you so much for your patience and support.

I am really very, very appreciative.

:)Outlook Rookie
 
Status
Not open for further replies.
Thread starter Similar threads Forum Replies Date
S outlook 2007 calendar search Using Outlook 6
S Outlook 2007 Calendar instant search problem. Windows 7 Using Outlook 4
S Outlook 2007 Calendar instant search problem. Windows 7 Using Outlook 0
S View Appointment in Text Wrap in Outlook 2007 Month Calendar View Using Outlook 0
R Outlook 2007 calendar colors Using Outlook 15
R Using Internet Calendar in Outlook 2007 within Citrix Using Outlook 1
F Outlook 2007 Calendar Appointments not in Outlook Today view Using Outlook 11
M calendar in outlook 2007 Using Outlook 1
M outlook 2007 calendar Using Outlook 2
J Outlook 2007 Error sharing Calendar: Error while preparing to send sharing message Using Outlook.com accounts in Outlook 2
P Outlook 2007 Calendar Ribbon has changed and I can't fix it Using Outlook 10
L Outlook 2007 Calendar Using Outlook 85
K Outlook 2007 Calendar - Time spinner does not function correctly Using Outlook 1
V Setting up windows 7 & outlook 2007 w/ Iphone 4 & synch contacts & calendar Using Outlook 9
M sync Outlook 2007 calendar with icloud Using Outlook 1
B Outlook 2007 and Live Calendar Stopped Synching Using Outlook.com accounts in Outlook 4
A Change calendar permissions in Outlook 2007 Using Outlook 9
M Missing Calendar in Outlook 2007 Using Outlook 3
B cant accept iCal calendar invites in Outlook 2007 (SP3) Using Outlook 4
D Calendar Permissions Outlook 2003, 2007 and 2010 Exchange Server Administration 2
M Outlook 2007 Calendar Reminders Using Outlook 1
H Conflicts with other event in calendar ( outlook 2007 &amp; 2010) Using Outlook 0
P Outlook 2007 - Missing Calendar Item Using Outlook 4
P Outlook 2007 - Missing Calendar Item Using Outlook 1
D Outlook 2007 & 2010 calendar permissions Using Outlook 2
D Outlook 2007 - MeetingPlace Express - Calendar error Using Outlook 1
S Calendar sharing problmes between Outlook 2007 &amp; 2010 Exchange Server Administration 0
V Outlook 2007-Tasks not displaying in calendar Using Outlook 4
J Outlook 2007 and 2010 for multiple calendar users Using Outlook 1
P Exporting Calendar, Contacts & Tasks from Outlook 2007 to Outlook 2003 Using Outlook 5
B Sharing Calendar in Outlook 2007 Using Outlook 1
A Outlook 2007 won't show appointments/meetings in calendar on actual date, only on date appt/mtg made Using Outlook 1
W Unable to sync Outlook contacts and calendar since upgrading from Outlook 2007 to Outlook 2010 Using Outlook 1
B Outlook 2007 is very slow to switch between mail, contacts, and calendar. Using Outlook 2
D How to push a second outlook 2007 'private' calendar on exchange 2007 to my mobile phone. Using Outlook 1
A "Item could not be found" error when attempting to send Outlook 2007 calendar event update Using Outlook 2
T My Outlook 2007 - (Public folder-Calendar can't insert to My Favourite)but other calender can insert Using Outlook 1
J Cannot see calendar appointments for Outlook 2007 Using Outlook 1
M Is it possible to have a public calendar map on a exchange server 2007 and synchronize this map and the items with outlook 2011 for MAC public map bro Using Outlook 2
K Outlook 2007 calendar linked to Hotmail showing wrong time. Using Outlook 3
G Share calendar between two Outlook 2010 OR 2007 without exchange where both users can make appointme Using Outlook 1
G Subscribing to Shared Outlook Calendar 2007 / 2010 from invitation leads to user name and password request. Using Outlook 2
G Subscribing to Shared Outlook Calendar 2007 / 2010 from invitation leads to user name and password request. Using Outlook 2
M I can't make any changes to my calendar in Outlook 2007 Using Outlook 2
M How do I recover all items in a deleted Outlook 2007 calendar not using Exchange Server? Using Outlook 3
K Outlook 2007 - Shared Calendar - Who created appointment? Using Outlook 4
L Outlook 2007 - Calendar Using Outlook 2
M Calendar status in Outlook 2007 Using Outlook 10
R How can I get my Outlook 2007 Calendar to synch with OWA Calendar? Using Outlook 1
D Outlook 2007 - how to edit calendar details style to include day Using Outlook 1
Similar threads


















































Top