?
Solved

Outlook Programming

Posted on 2006-03-27
76
Medium Priority
?
1,487 Views
Last Modified: 2008-07-08
This is my first foray into programming in MS Office. Can someone give me some pointers on how to start to create a macro that, when an appointment is added to one outlook personal calendar on Exchange, that appointment is then copied to a shared calendar?
0
Comment
Question by:cescentman
  • 40
  • 32
  • 3
75 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 16306679
Hi cescentman,

Here's an example I wrote for another question:

'Macro Begins Here
Private WithEvents objCalendarItems As Items

Private Sub Application_Startup()
    Set objCalendarItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
    Dim objAppointment As Outlook.AppointmentItem, _
        objFolder As Outlook.MAPIFolder
    If Item.Sensitivity <> olPrivate Then
        'Change the path to the shared calendar on the following line
        Set objFolder = OpenMAPIFolder("\Container\Folder\EECalendar")
        Set objAppointment = Item.Copy
        objAppointment.Move objFolder
        Set objAppointment = Nothing
        Set objFolder = Nothing
    End If
End Sub

Private Sub Application_Quit()
    Set objCalendarItems = Nothing
End Sub

'Credit where credit is due.
'The code below is not mine (well, a little of it is).  I found it somewhere on the
'internet but do not remember where or who the author is.  The original author(s)
'deserves all the credit for these functions.
Function OpenMAPIFolder(ByVal szPath As String)
    Dim app, ns, flr As MAPIFolder, szDir, i
    On Error GoTo errOMF
    Set flr = Nothing
    Set app = CreateObject("Outlook.Application")
    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
    Else
        Set flr = app.ActiveExplorer.CurrentFolder
    End If
    While szPath <> ""
        i = InStr(szPath, "\")
        If i Then
            szDir = Left(szPath, i - 1)
            szPath = Mid(szPath, i + Len("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
    On Error GoTo 0
    Exit Function
errOMF:
    Set OpenMAPIFolder = Nothing
    On Error GoTo 0
End Function

Function IsNothing(Obj)
  If TypeName(Obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
'Macro Ends Here

Cheers!
0
 
LVL 1

Author Comment

by:cescentman
ID: 16372348
I am sorry for the delay in responding to this life has been unexpectadly hectic and my focus has been dragged away form this task. Promise I won't forget!!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16376556
I understand.  Take your time.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Author Comment

by:cescentman
ID: 16434601
stiil on hold but haven't forgotten - sorry.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16434609
No problem.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16570328
Any update, cescentman?
0
 
LVL 1

Author Comment

by:cescentman
ID: 16625678
Been away - have not yet had a chance tolook it over sorry to be such a pain
0
 
LVL 1

Author Comment

by:cescentman
ID: 16795740
OK this has spurred me into getting on with this. I am sorry it has taklen so long these last few months have been stpidly hectic.

OK I have tried to apply the code but macros and VBA are foreign countries to me and I am blowed if I can see how and where I can apply the code. I have tried pasting the code into the window that pops up when you hit create for a macro but nothing happens. Can you offer me a little mopre guidance on how to use the code?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16797001
Hi, cescentman.

Follow these instructions to use the code:

1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
4.  Copy the code below and paste it into the right-hand pane of the VB Editor window
5.  Edit the code making the changes per the comments I embeded in the code
6.  Click the diskette icon on the toolbar to save the changes
7.  Close the VB Editor
8.  Click Tools->Macro->Security
9.  Set the Security Level to Medium.  
10.  Close Outlook
11.  Start Outlook
12.  Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run.  Say yes.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16840465
OK have done this, a couple things were different firstly when I opened the editor, the right hand pane defaulted to a module 1 and I had to double click on ThisOutlookSession and then paste the code below some seemingly empty sub entries. Hope this was OK.

When I reopened Outlook and enabled macros I got a compile error: "Invalid attribute in Sub or Function". The VB editor opened the line "Private WithEvents objCalendarItems As Items" was highlighted. I tried deleting this line saving and restarting. This did not create an error. However when I try to add events on to the calendar they don't get copied.

This brings me on to something else I am not clear about. the line I have to change "OpenMAPIFolder("\Container\Folder\EECalendar")". I have a personal mail box called "Mailbox - Charlie Markwick" in which I have a personal calendar. What I want to do is copy events that I enter here to the shared public calendar in public folders. so the question is should the path read "OpenMAPIFolder("\Public Folders\All Public Folders\Company Calendar")" in other words exactly as it appears in the folder view of Outlook?

Sorry if I am being thick on this, I am very grateful for your continued help.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16840818
> Hope this was OK.
Yes, that was ok.

> I tried deleting this line saving and restarting
That line has to be there for this to work.  Try this modified version of it though.

    Private WithEvents objCalendarItems As Outlook.Items

> exactly as it appears in the folder view of Outlook?
Yes.

> Sorry if I am being thick on this, I am very grateful for your continued help.
No, you're not being thick.  You're welcome.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16841252
well it's stepping forward  I know get a run time error when I add an item to the celendar:-

Run-time error '-2147221233 )8004010f)':
Method 'Sensitivity' of object 'Appointment' failed
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16847583
Assuming that you've typed the message exactly as it appears, then I'm stumped.  There are no instances of an object named Appointment in my code.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16849567
Mea Culpa this ought to have read:-
Run-time error '-2147221233 )8004010f)':
Method 'Sensitivity' of object 'AppointmentItem' failed

If I rem out just the lines:-
If Item.Sensitivity <> olPrivate Then
and
End If

Then another error pops up:-
Run-time error '-2147221233 )8004010f)':
Method 'Copy' of object 'AppointmentItem' failed

The other thing I have just noticed is that in both cases the appointment is copied to the public calendar.  However the code is then disabled and it wil not run again until I restart Outlook.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16857904
What version of Outlook are you using?
0
 
LVL 1

Author Comment

by:cescentman
ID: 16858756
2003 (11.8010.6568) SP2
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16859845
This is a bit of a long shot, but the only explanation I can see that explains the behavior you're encountering is if something other than an appointment is being added to the calendar.  I've modified the code in the main subroutine to check what type of item is being added and ignore everything except appointments.  Swap this code for the code you have and let me know what happens.

Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
    Dim objAppointment As Outlook.AppointmentItem, _
        objFolder As Outlook.MAPIFolder
    If Item.Class = olAppointment Then
        If Item.Sensitivity <> olPrivate Then
            'Change the path to the shared calendar on the following line
            Set objFolder = OpenMAPIFolder("\Container\Folder\EECalendar")
            Set objAppointment = Item.Copy
            objAppointment.Move objFolder
            Set objAppointment = Nothing
            Set objFolder = Nothing
        End If
    End If
End Sub
0
 
LVL 1

Author Comment

by:cescentman
ID: 16860284
No I just get the same error:-

Run-time error '-2147221233 )8004010f)':
Method 'Sensitivity' of object 'AppointmentItem' failed

Debugger halts on If Item.Sensitivity <> olPrivate Then

Thanks for keeping with this.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16892666
Well, I'm a bit stumped.  Appointment items in Outlook 2003 definitely have a Sensitivity property and olPrivate is a pre-defined constant that describes the sensitivity level.  I cannot fathom how this can fail to work.  I've also tested the code on two of my computers, both with Outlook 2003 and it works perfectly.  So I know it works with 2003.  How comfortable are you working in the VBA editor?  What we're going to need to do to figure this out is set a breakpoint and step through the code line by line while we check the values of various things.  
0
 
LVL 1

Author Comment

by:cescentman
ID: 16894374
OK I'm a pretty quick learner - do you want to take this opff forum, shall I e-mails you direct?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16897923
EE rules don't permit a direct email exchange.  It'd prevent other experts from participating and there wouldn't be a record of what we did to solve this.  Here's what I need you to do:

1.  Open the VB editor.
2.  Find the code in question and click anywhere in this line:

        If Item.Class = olAppointment Then

3.  Press F9.  The line of code will turn red.  We've just set a breakpoint.  Code execution will stop whenever it hits this line giving us control and allowing us to look at the value of various things.
4.  Minimize the code window.  
5.  Go to your calendar.
6.  Create and save a test appointment.
7.  On clicking Save the code window should reappear with the line we set the breakpoint on appearing in yellow.
8.  Double-click on the word Item in either of the two IF statements.  That should highlight Item.
9.  Press Shift+F9.  This will set a watch, allowing us to see the value of that variable.  Watches appear in the lower right-hand pane.  There are four columns in that pane.  First order of business is to tell me what Type and Value are shown for Item.
10.  Next, block Item.Sensitivity and press Shift+F9 again.  This will add another watch.  Tell me what the first three columns say about it.
11. Click Run->Reset to cancel the debugging session.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16898260
Sorry I had no intention of breaching protocol.


Watch : - : Item : "test" : Object/AppointmentItem : ThisOutlookSession.objCalendarItems_ItemAdd
    :  : <No Variables> :  : ThisOutlookSession.objCalendarItems_ItemAdd

Watch :   : Item.Sensitivity : 0 : Variant/Long : ThisOutlookSession.objCalendarItems_ItemAdd
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16898335
> Sorry I had no intention of breaching protocol.
No problem.  A lot of folks aren't aware of the rules.  I was just explaining why it's not allowed.

Ok, so Sensitivity is there and Item is an AppointmentItem.  This is so very strange.  Try changing this line

    If Item.Sensitivity <> olPrivate Then

to

    If Item.Sensitivity <> 2 Then

Try and run it again.  No need to set a breakpoint or check values, just let it run and tell me what happens.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16898365
Run-time error '-2147221233 )8004010f)':
Method 'Copy' of object 'AppointmentItem' failed

I'm afraid
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16901012
The behavior here is very strange.  First we get an error saying that Sensitivity isn't a valid property, and now it's apparently okay.  Now we can't copy.  Okay, let's go back to the debugging steps above.  Run through steps 1-9.  Then pick up with these steps.

10.  Press F8.  This will execute the line of code in yellow and then step forward one line.  
11.  Repeat step #10 four time.  That should get us to the point where the line with the copy command has been executed.  Make a note of the value of Item when that line of code is in yellow but before you've pressed F8 on it.

Let me know what happens.  I'm curious to see if stepping through the code line by line makes any difference in the outcome.  Let me know what happens and what the value of Item was immediately prior to executing that line of code.  If Item has the expected value yet the line fails, then we'll have to explore the possibility that something is wrong with Outlook.  If instead that line of code succeeds while stepping through in the debugger, then we either have something stranger going on.  What kind of computer are you running this on?  I'm not really interested in make and model, but processor type and speed.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16909132
The PC is running Intel P4 3E Ghz with 1Gb RAM

Stepping through requires more than 4 steps to reach the line as when it reacvhes the line "Set objFolder = OpenMAPIFolder ..." it runs the functions OpenMAPIFolder and IsNothing

Just prior to running "Set objAppointment = Item.Copy" the values are the same bar the value of item which reflects the text I entered in the appointment.

The code works without an error when stepping through. but not otherwise.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16909937
Oops, sorry, I wasn't taking into account the fact that you have to go through OpenMAPIFolder.  The fact that the process works when stepping through it in the debugger demonstrates that the code is working.  The difference between stepping though the code in the debugger and normal execution is timing.  When we step through the code it's running slower than it normally would.  It's almost as if the computer is executing the instructions too fast for Outlook to keep up.  Or like it's executing the instructions out of sequence.  Does this comptuer have Hyperthreading and, if so, is it turned on?  If yes, can we turn it off and test again?
0
 
LVL 1

Author Comment

by:cescentman
ID: 16913230
Turning off HyperThreading makes no difference, in fact it doesn't seem to make any difference to anything (does it really offer any advantage?)!!

Just out of interest (I'm mostly out of my depth here) I changed the line "If Item.Sensitivity <> 2 Then"to "If Item.Sensitivity <> 2 Then" to see if it worked just checking if Item.Sensitivity isn't nothing. It worked without the error but then stopped. From then on an additions to the one calendar fail to appear on the other. It seems as though from then it stops running as even putting in a breakpoint as you outlined failed to generate any action.

It seems as though once the script has run once, irrespective of whether it gives an error or not it will not run again. I can find no way to start it and have to close Outlook and start it up again.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16932521
Just looked at what I wrote it should have read:-

"... I changed the line "If Item.Sensitivity <> 2 Then"to "If Item.Sensitivity Then" to see if it worked ..."

Have we come to a dead end?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16933010
I'm at a loss to explain what's going on and cannot think of a suitable way to get around it.  The point of testing Item.Sensitivity is to avoid copying items that've been marked as private.  We can leave the test out and the resulting code should copy everything added to the calendar.  That's one way around this, but it doesn't seem appropriate.  As mentioned above, the problem seems like a timing issue, almost as if the code is executing too fast or out of sequence.  We know the code works if executed through the debugger and we know it doesn't when it runs by itself.  We know the Sensitivity property is there and has a value.  For the code to then generate the error it's giving the If ... Then would have to be firing before the property is available or under some condition where it cannot be seen or read.  That seems impossible but I don't see any other explanation.  We can run some additional tests in the hopes of pinpointing what's going on.  Are you up for that?
0
 
LVL 1

Author Comment

by:cescentman
ID: 16933037
Absolutely I am very grateful for the time and effort you are putting into this. I only wish I could increase  the points above 500. We could at some point organise a remote session using Webex if that would help, I have an account.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16933077
> organise a remote session using Webex if that would help
Yes, that would help.  It always helps to be able to "see" what's going on.  I might notice things that you wouldn't and it would speed the process up a lot.  Unfortunately it's against the rules.  I appreciate the thought on points, but I do this for other reasons than just points.  Besides which it's now turned into a mystery I want to see solved.  I'll post some troubleshooting code as quick as I can, but before the day is out.  All it'll do is attempt to record information about the state of Outlook during this process to a text file.  You'll then post the results of the text file here and I'll see if I can figure out what's going on.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16939317
Replace objCalendarItems_ItemAdd with the one below.  Leave the rest of the code as is.  Close and re-start Outlook.  This code is going to write a log file the will contain all the details of every item added to the calendar.  After re-starting Outlook add a couple of test appointments and let's see what happens.  If it generates an error, then please note down the error and what line of code triggered it.  If it does not cause any errors.  Then copy and paste the contents of the file here so I can see the output.  The file will be in the root of C: and will be called "Calendar History.txt".  


Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
    Dim objFSO As Object, _
        objFile As Object, _
        olkProp As Outlook.ItemProperty
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile("C:\Calendar History.txt", 8, True)
    With Item
        objFile.WriteLine "New Item"
        For Each olkProp In .ItemProperties
            If olkProp.Type <> olOutlookInternal Then
                objFile.WriteLine "  " & olkProp.Name & ": " & olkProp.Value
            End If
        Next
    End With
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set olkProp = Nothing
End Sub
0
 
LVL 1

Author Comment

by:cescentman
ID: 16939947
New Item
  Class: 26
  BillingInformation:
  Body:
  Categories:
  Companies:
  ConversationIndex: 01C6942AA52C67806CA4A8984C7C927B849A6F95B3BF
  ConversationTopic: test5
  CreationTime: 20/06/2006 06:30:30
  EntryID: 0000000027CF51E2CBBC324D94512AB680EF04B80700CB70B5CCE4319D4ABEA54BB12D3117CF00000000004C0000CB70B5CCE4319D4ABEA54BB12D3117CF000000001B7A0000
  Importance: 1
  LastModificationTime: 20/06/2006 06:30:30
  MessageClass: IPM.Appointment.My WebEx Integration
  Mileage:
  NoAging: False
  OutlookInternalVersion: 118010
  OutlookVersion: 11.0
  Saved: True
  Sensitivity: 0
  Size: 508
  Subject: test5
  UnRead: False
  AllDayEvent: False
  BusyStatus: 2
  Duration: 30
  IsOnlineMeeting: False
  IsRecurring: False
  Location:
  MeetingStatus: 0
  NetMeetingAutoStart: False
  NetMeetingOrganizerAlias:
  NetMeetingServer:
  NetMeetingType: 0
  OptionalAttendees:
  Organizer: cescentman
  RecurrenceState: 0
  ReminderMinutesBeforeStart: 15
  ReminderOverrideDefault: False
  ReminderPlaySound: False
  ReminderSet: True
  ReminderSoundFile:
  RequiredAttendees:
  Resources:
  ResponseRequested: True
  ResponseStatus: 0
  NetMeetingDocPathName:
  NetShowURL:
  ConferenceServerAllowExternal: True
  ConferenceServerPassword:
  DownloadState: 1
  InternetCodepage: 28591
  MarkForDownload: 0
  IsConflict: False
  MeetingWorkspaceURL:
  AutoResolvedWinner: False
  AttendeeInfo:
  MeetingInfo:
  MeetingType:
  Reserved1:
  Reserved2:
  TrackingCode:
New Item
  Class: 26
  BillingInformation:
  Body:
  Categories:
  Companies:
  ConversationIndex: 01C6942AC24541AD050312544F0F94024F470FA6E0C7
  ConversationTopic: Test6
  CreationTime: 20/06/2006 06:30:37
  EntryID: 0000000027CF51E2CBBC324D94512AB680EF04B80700CB70B5CCE4319D4ABEA54BB12D3117CF00000000004C0000CB70B5CCE4319D4ABEA54BB12D3117CF000000001B7B0000
  Importance: 2
  LastModificationTime: 20/06/2006 06:31:19
  MessageClass: IPM.Appointment.My WebEx Integration
  Mileage:
  NoAging: False
  OutlookInternalVersion: 118010
  OutlookVersion: 11.0
  Saved: True
  Sensitivity: 0
  Size: 24693
  Subject: Test6
  UnRead: False
  AllDayEvent: False
  BusyStatus: 2
  Duration: 4350
  IsOnlineMeeting: False
  IsRecurring: False
  Location:
  MeetingStatus: 0
  NetMeetingAutoStart: False
  NetMeetingOrganizerAlias:
  NetMeetingServer:
  NetMeetingType: 0
  OptionalAttendees:
  Organizer: cescentman
  RecurrenceState: 0
  ReminderMinutesBeforeStart: 15
  ReminderOverrideDefault: False
  ReminderPlaySound: False
  ReminderSet: True
  ReminderSoundFile:
  RequiredAttendees:
  Resources:
  ResponseRequested: True
  ResponseStatus: 0
  NetMeetingDocPathName:
  NetShowURL:
  ConferenceServerAllowExternal: True
  ConferenceServerPassword:
  DownloadState: 1
  InternetCodepage: 28591
  MarkForDownload: 0
  IsConflict: False
  MeetingWorkspaceURL:
  AutoResolvedWinner: False
  AttendeeInfo:
  MeetingInfo:
  MeetingType:
  Reserved1:
  Reserved2:
  TrackingCode:
New Item
  Class: 26
  BillingInformation:
  Body:
  Categories:
  Companies:
  ConversationIndex: 01C6942ACD4AF8D4905A5E3B44ECBB21A62A0928D2CA
  ConversationTopic: test7
  CreationTime: 20/06/2006 06:31:25
  EntryID: 0000000027CF51E2CBBC324D94512AB680EF04B80700CB70B5CCE4319D4ABEA54BB12D3117CF00000000004C0000CB70B5CCE4319D4ABEA54BB12D3117CF000000001B7C0000
  Importance: 1
  LastModificationTime: 20/06/2006 06:31:38
  MessageClass: IPM.Appointment.My WebEx Integration
  Mileage:
  NoAging: False
  OutlookInternalVersion: 118010
  OutlookVersion: 11.0
  Saved: True
  Sensitivity: 2
  Size: 24693
  Subject: test7
  UnRead: False
  AllDayEvent: False
  BusyStatus: 2
  Duration: 30
  IsOnlineMeeting: False
  IsRecurring: False
  Location:
  MeetingStatus: 0
  NetMeetingAutoStart: False
  NetMeetingOrganizerAlias:
  NetMeetingServer:
  NetMeetingType: 0
  OptionalAttendees:
  Organizer: cescentman
  RecurrenceState: 0
  ReminderMinutesBeforeStart: 15
  ReminderOverrideDefault: False
  ReminderPlaySound: False
  ReminderSet: True
  ReminderSoundFile:
  RequiredAttendees:
  Resources:
  ResponseRequested: True
  ResponseStatus: 0
  NetMeetingDocPathName:
  NetShowURL:
  ConferenceServerAllowExternal: True
  ConferenceServerPassword:
  DownloadState: 1
  InternetCodepage: 28591
  MarkForDownload: 0
  IsConflict: False
  MeetingWorkspaceURL:
  AutoResolvedWinner: False
  AttendeeInfo:
  MeetingInfo:
  MeetingType:
  Reserved1:
  Reserved2:
  TrackingCode:
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16940842
The only thing that jumps out at me is that you appear to be using a modified Outlook form.  Is that correct?
0
 
LVL 1

Author Comment

by:cescentman
ID: 16943789
Is that the IPM.Appointment.My WebEx Integration? If so I have Webex and also Skype integration on Outlook. Sorry if I should have told you about this before, it never occurred to me.
0
 
LVL 1

Author Comment

by:cescentman
ID: 16996816
I shall be away for the next week
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16997178
Ok.  Sorry I hadn't responded.  I mistakenly filed this question under "waiting on someone else".
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17019471
Yes, that's the "IPM.Appointment.My WebEx ".  What that tells me is that this is a customized version of the standard Appointment form.  Since it isn't a standard Appointment item it may not behave the same as an Appointment would.  The simplest solution to our problem is to remove the test for a private item and copy everything.  The code below does that.  The down side to doing this is that it will copy everything on your calendar including items you might not want to share.

Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
    Dim objAppointment As Outlook.AppointmentItem, _
    objFolder As Outlook.MAPIFolder
    'Change the path to the shared calendar on the following line
    Set objFolder = OpenMAPIFolder("\Container\Folder\EECalendar")
    Set objAppointment = Item.Copy
    objAppointment.Move objFolder
    Set objAppointment = Nothing
    Set objFolder = Nothing
End Sub
0
 
LVL 1

Author Comment

by:cescentman
ID: 17035545
OK will try this - am away at the moment but will check it out when I gat back.
0
 
LVL 1

Author Comment

by:cescentman
ID: 17097283
Hmm not good news I'm afraid, it fails on the line:-

Set objAppointment = Item.Copy

With our old friend:-

"Run-time error '-2147221233 )8004010f)':
Method 'Copy' of object 'AppointmentItem' failed"

0
 
LVL 1

Author Comment

by:cescentman
ID: 17119932
Are we at the end of the road with this?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17120540
Not unless you want to call it quits.  Sorry to be slow, I've been busy with other things.  I expect the continuing error message is a result of the WebEx form.  Short of removing the WebEx integration altogether I'm not sure how to get around this.  
0
 
LVL 1

Author Comment

by:cescentman
ID: 17120710
I have no trouble with your response time - my anxiety was that you were fed up with it. I am keen to resolve it and am happy to work to your own schedules. I am happy to remove the webex integration. If then that proves to be the problem there is no reason why I can't refer it to their technical support once we have a clear description of what the problem is.
0
 
LVL 1

Author Comment

by:cescentman
ID: 17121612
I have unuinstalled the webex integration and stil get the error. I also have the follwoing installed:-

Skype integration
spambayes
Google desktop search

Can any of these be the problem?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17127030
I suppose they could be, but I had a thought about this today while I was driving to work.  Sometimes you can't see the forest for the trees.  Edit the procedure named objCalendarItems_ItemAdd and change this line

        Dim objAppointment As Outlook.AppointmentItem, _

to

        Dim objAppointment As Object, _


Give it another try and let me know what happens.
0
 
LVL 1

Author Comment

by:cescentman
ID: 17127795
Sorry, Nope still keels over but like before it does copy the item.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17128629
Ok, purely as a test can you create a test calendar, put a couple of appointments on it, and try the code against it?  To point at a different calendar, simply change the folder path on this line:

    Set objFolder = OpenMAPIFolder("\Container\Folder\EECalendar")
0
 
LVL 1

Author Comment

by:cescentman
ID: 17192334
Sorry but been frantically getting ready t go away for a fortnight. Is it Ok if I pick up on it when I get back (unless of course I get bored on holiday and sneak away and find a WiFi Hotshot)?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17197250
That's fine.  Enjoy your holiday!
0
 
LVL 1

Author Comment

by:cescentman
ID: 17387615
Hi I'm back and rested. The whole PC that I am using is beginning to creak. So I thought that I would have to bite the bullet in a few weeks time and reinstall. I will try this code with a new install of outlook and see if it still has this problem and work from there. I want you to have the points but  it would be good to add the outcome of the new install. How do you want to play this. I can sign it off now and allocate the points to you and let you know off list the outcome. Or we can try and keep the thread open until the rebuild is done?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17390557
Let's keep the thread open until we have this worked out.  There's no rush to close the question.  We just need to put something in at lest once every 21 days to keep it from becoming an abandoned question.
0
 
LVL 1

Author Comment

by:cescentman
ID: 17395235
OK won't forget
0
 
LVL 1

Author Comment

by:cescentman
ID: 17395471
Just for completeness sake I did the last test. No go got:-

Run-time error '-2147221233 )8004010f)':
Method 'Sensitivity' of object 'Appointment' failed

As before the item does get copied. Don't worry about responding I'll gat eback to you.
0
 
LVL 20

Expert Comment

by:Venabili
ID: 17469030
Any news here?
0
 
LVL 1

Author Comment

by:cescentman
ID: 17469280
Not as yet - it is waiting on me to get a new machine running. We will complete the thread.
0
 
LVL 20

Expert Comment

by:Venabili
ID: 17581160
News?
0
 
LVL 1

Author Comment

by:cescentman
ID: 17672734
Installin the new machine next week
0
 
LVL 20

Expert Comment

by:Venabili
ID: 17743746
Any news?
0
 
LVL 1

Author Comment

by:cescentman
ID: 17847843
Bad news I'm afraid. Loaded Outlook, no snapins, absolutely virgin install all updates. and still using your original code I get the message:-

Run-time error '-2147221233 (8004010f)':
Method 'Sensitivity' of object 'Appointment' failed

Screeeeeeeeeeeeeeeeeeeeeam
0
 
LVL 1

Author Comment

by:cescentman
ID: 17857204
I have been checking out the rules:-

"The same applies to the use of Remote Access to resolve a problem. We recognise that sometimes, the only solution is a hands-on tinkering with a configuration, but this should be considered a last resort, and only with the full permission of the other participants in the question, and only with the full and complete disclosure of the methods used to resolve the problem. Any points awarded without the posting of both of these criteria will be removed from both the Asker's and the Expert's totals."

If you are willing to help in this way then I could make a commitment to write up the "full and complete disclosure of the methods used to resolve the problem" here? Looking over the thread it seems that there is only you,  Yoana Yotova and myself in the thread. I can offer RDP and also Webex for remote access.

I will understand if you prefer not.
0
 
LVL 1

Author Comment

by:cescentman
ID: 18013739
Hi BlueDevilFan do you want to close this off?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18014359
Sorry, cescentman, I lost track of this question.  I thought I'd replied to your suggestion, but obviously I was mistaken.  I don't mind RDPing in and having a look, but how could we arrange that?  Would we need to be on the phone, or would we set up a time, or ...?
0
 
LVL 1

Author Comment

by:cescentman
ID: 18014505
OK shall I e-mail you on the contact e-mail on your profile to start the setting up our arrangement?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18014515
Please do.
0
 
LVL 1

Author Comment

by:cescentman
ID: 18014549
ee-BlueDevilFan at earthlink.net rendered as a conventional e-mail address bounced do you want to try me:

eex the domain southcot TLD
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18015062
Ok, I've sent you a message.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18015148
I just got a non-delivery report back saying that delivery failed due to an "Unrouteable address".  
0
 
LVL 1

Author Comment

by:cescentman
ID: 18017736
OK - looking at the bounce I got form yours it seems that earthlink is beefing about the fact that I'm stuck behind DHCP. I'll try using my googlemail account.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18018117
Ok
0
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 18075761
cescentman,

After several debugging sessions I finally came up with a way that appears to work all the time.  Replace the olkCalendarItems_ItemAdd sub you have now with the one below.  I've run it through creating 10-15 appointments and they were all moved correctly to the shared calendar.  The approach I've taken here is to turn off monitoring your calendar while the copy is taking place, then turn monitoring back on when it's finished.  This avoids putting us in an infinite loop where making a copy of the added item calls the sub a second time.  I tried creating an item in the shared calendar and then copying the item property by property, but the resulting appointment end time always changed.  I can't understand why, but couldn't change the behavior and had to abandon that idea.  Please give this a try and let me know how it goes.

Private Sub olkCalendarItems_ItemAdd(ByVal Item As Object)
   Dim olkAppointment As Outlook.AppointmentItem, _
        olkFolder As Outlook.MAPIFolder
    If Item.Sensitivity <> olPrivate Then
        'Change the path to the shared calendar on the following line
        Set olkCalendarItems = Nothing
        Set olkFolder = OpenMAPIFolder("\Public Folders\All Public Folders\Company Calendar")
        Set olkAppointment = Item.Copy
        olkAppointment.Move olkFolder
        Set olkAppointment = Nothing
        Set olkFolder = Nothing
        Set olkCalendarItems = Session.GetDefaultFolder(olFolderCalendar).Items
    End If
End Sub
0
 
LVL 1

Author Comment

by:cescentman
ID: 18083091
That works fine. I am very very grateful for the time you have put into this. Just a small point for anyone visiting this in the future, the code above uses the prefix olk as opposed to obj  for objects, for the sake of consistency in my installation I changed it back.
0
 
LVL 1

Author Comment

by:cescentman
ID: 18083094
Do we need to catalogue anything else? If not then I will close off and allocate you 1,000,000 points!!!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18083896
> That works fine.
Excellent.

> I am very very grateful for the time you have put into this
No problem.  I'm just sorry that it took me so long to see what was happening and get it solved.

> Do we need to catalogue anything else?
I think we're good.  
0
 
LVL 1

Author Comment

by:cescentman
ID: 18083941
Brilliant, thanks once again
0

Featured Post

Get quick recovery of individual SharePoint items

Free tool – Veeam Explorer for Microsoft SharePoint, enables fast, easy restores of SharePoint sites, documents, libraries and lists — all with no agents to manage and no additional licenses to buy.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article lists the top 5 trialware OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their Exchange server is no longer available or other critical issues with Exchange server or impo…
This article will help to fix the below errors for MS Exchange Server 2016 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
Suggested Courses

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question