I have several clients and e-mail accounts with each one that I'm forced to deal with. When I'm with a particular client I have to schedule a meeting -- however, the calendar in their outlook/exchange wouldn't be synchronized with my other calendars -- client2, and client3.
1. However, the calendar items created by this macro are not always "stable" soemtimes they show and then "cancel" by themselves, other times they just don't show -- even when everyone accepts them.
2. I get messages in my inboxe for every calendar item I create -- that just fills my in box, which didn't used to happen (before I wrote the macro) and created a calendar item and added addressees by hand.
I cut and pasted this VB macro from other macros on this and other sites. This Macro works about 70% of the time. I found that I had to set -- Item.MeetingStatus = olMeeting -- to get the Meeting item to save and feel as though there's something else VERY simple that I'm missing.
Any help would be greatly appreciated.
P.S. Do not fool around with ItemChange to do something similar to this -- the malestrom of messages nearly locked up my machine.
--- Start of code in ThisOutlookSession ---
Option Explicit
Public WithEvents MyOlItems As Outlook.Items
Public MyInProcess As Integer
Private Sub Initialize_Handler()
Set MyOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub Application_MAPILogonComplete()
'Initialize_Handler
End Sub
Private Sub Application_Startup()
Initialize_Handler
Debug.Print "*** Startup ***"
End Sub
Private Sub MyOlItems_ItemAdd(ByVal Item As Object)
'Exit if already processing a mail item
If MyInProcess Then Exit Sub
MyInProcess = -1
Debug.Print "* A -";
ProcessCalendarItem Item
MyInProcess = 0
End Sub
Private Function ProcessAddress(ByVal Item As Outlook.AppointmentItem, ByVal MyAddress As String) As
Integer
Dim MyRecipient As Recipient
Dim MyFlag As Integer
MyAddress = LCase(Trim(MyAddress))
'Search for my Address in the list of addressees -- check out SMTP
MyFlag = -1
For Each MyRecipient In Item.Recipients
If InStr(1, LCase(MyRecipient.AddressEntry), MyAddress) Then
MyFlag = 0
Exit For
End If
Next
'Add my Address to the list of addressees
If MyFlag Then
Item.Recipients.Add MyAddress
Item.MeetingStatus = olMeeting 'Have to add this to make the address take??
Item.Save
End If
ProcessAddress = MyFlag
End Function
Private Sub ProcessCalendarItem(ByVal Item As Object)
Dim MyFlag As Integer
If Item.Class <> olAppointment Then
Debug.Print Item.Class; " <-- Not Appointment Item"
Exit Sub
End If
Debug.Print Item.Recipients.Count
MyFlag = ProcessAddress(Item, "(e-mail address removed)")
MyFlag = MyFlag + ProcessAddress(Item, "(e-mail address removed)")
MyFlag = MyFlag + ProcessAddress(Item, "(e-mail address removed)")
MyFlag = MyFlag + ProcessAddress(Item, "(e-mail address removed)")
If MyFlag Then Item.Send
End Sub
--- End of code ---
1. However, the calendar items created by this macro are not always "stable" soemtimes they show and then "cancel" by themselves, other times they just don't show -- even when everyone accepts them.
2. I get messages in my inboxe for every calendar item I create -- that just fills my in box, which didn't used to happen (before I wrote the macro) and created a calendar item and added addressees by hand.
I cut and pasted this VB macro from other macros on this and other sites. This Macro works about 70% of the time. I found that I had to set -- Item.MeetingStatus = olMeeting -- to get the Meeting item to save and feel as though there's something else VERY simple that I'm missing.
Any help would be greatly appreciated.
P.S. Do not fool around with ItemChange to do something similar to this -- the malestrom of messages nearly locked up my machine.
--- Start of code in ThisOutlookSession ---
Option Explicit
Public WithEvents MyOlItems As Outlook.Items
Public MyInProcess As Integer
Private Sub Initialize_Handler()
Set MyOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub Application_MAPILogonComplete()
'Initialize_Handler
End Sub
Private Sub Application_Startup()
Initialize_Handler
Debug.Print "*** Startup ***"
End Sub
Private Sub MyOlItems_ItemAdd(ByVal Item As Object)
'Exit if already processing a mail item
If MyInProcess Then Exit Sub
MyInProcess = -1
Debug.Print "* A -";
ProcessCalendarItem Item
MyInProcess = 0
End Sub
Private Function ProcessAddress(ByVal Item As Outlook.AppointmentItem, ByVal MyAddress As String) As
Integer
Dim MyRecipient As Recipient
Dim MyFlag As Integer
MyAddress = LCase(Trim(MyAddress))
'Search for my Address in the list of addressees -- check out SMTP
MyFlag = -1
For Each MyRecipient In Item.Recipients
If InStr(1, LCase(MyRecipient.AddressEntry), MyAddress) Then
MyFlag = 0
Exit For
End If
Next
'Add my Address to the list of addressees
If MyFlag Then
Item.Recipients.Add MyAddress
Item.MeetingStatus = olMeeting 'Have to add this to make the address take??
Item.Save
End If
ProcessAddress = MyFlag
End Function
Private Sub ProcessCalendarItem(ByVal Item As Object)
Dim MyFlag As Integer
If Item.Class <> olAppointment Then
Debug.Print Item.Class; " <-- Not Appointment Item"
Exit Sub
End If
Debug.Print Item.Recipients.Count
MyFlag = ProcessAddress(Item, "(e-mail address removed)")
MyFlag = MyFlag + ProcessAddress(Item, "(e-mail address removed)")
MyFlag = MyFlag + ProcessAddress(Item, "(e-mail address removed)")
MyFlag = MyFlag + ProcessAddress(Item, "(e-mail address removed)")
If MyFlag Then Item.Send
End Sub
--- End of code ---