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:
 
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.
 
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.
 
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
 
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).
 
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! :)
 
Hello again,

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

Thank you.
 
Hi.

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

Thank you.
 
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
 
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.
:(
 
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
 
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
 
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
 
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!
 
Happy New Year to all at this Forum!

Do you have an update?

Thank you.
 
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
 
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.
Similar threads
Thread starter Title 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
B Scheduling a Meeting Resource (Room) with a conflict doesn't indicate any conflict on users calendar in Outlook 2007 Using Outlook 1
P the outlook 2007 calendar cannot be saved because it was changed by another user or in another windo Using Outlook 4
G How re referance a non defualt outlook 2007 calendar Outlook VBA and Custom Forms 3
J Outlook 2007 hangs when Calendar tab is clicked Exchange Server Administration 49
G Outlook 365 My iCloud Outlook doesn’t work after reinstalling Microsoft365 on Windows 10 PC – now I get error message on contacts and calendar Using Outlook 1
P Can no longer sync Outlook with iPhone calendar after iPhone update to 17.1.1 Using Outlook 7
H Outlook 365 O365 outlook calendar item editing Using Outlook 1
Kika Melo Outlook Calendar deleted appointments not in Deleted Items folder Using Outlook 3
icacream Outlook 2021 - Google calendar in the peek Using Outlook 0
e_a_g_l_e_p_i MY Outlook 2021 changed the format of the shortcuts for mail, calendar etc. Using Outlook 10
L Synch Outlook 365 calendar with iPhone Using Outlook 0
L Duplicate calendar entries in Outlook 365 Using Outlook 3
G Stop Outlook 365 adding meetings to calendar Using Outlook 1
J Event/Meeting in Outlook Does Not Align with SharePoint Calendar Using Outlook 5
C How to import Outlook calendar? Using Outlook 1
e_a_g_l_e_p_i Outlook 2021 all appointments not showing in calendar Using Outlook 2
V iCloud calendar problems, Outlook shuts down immediately Using Outlook 2
J VBA for outlook to compare and sync between calendar Outlook VBA and Custom Forms 1
A force outlook to default to MY calendar Using Outlook 3
P Outlook calendar and contacts sync problem-outlook disconnects Using Outlook.com accounts in Outlook 2
HarvMan Toggle between calendar and email in Outlook 365 Using Outlook 12

Similar threads

Back
Top