Solved

Need help with this macro code

Posted on 2010-08-16
135
762 Views
Last Modified: 2013-12-14
I have this macro bode, which supposed to move items from one folder to another in outlook.

is it possible to make some changes to it and make it move calendar items from a PST, which is opened in outlook to a folder in the mailbox, which stores calendar items?

if so what changes need to be made?

any help is much appreciated.

Code Starts:

Sub MoveSelectedMessagesToToDo()

On Error Resume Next
    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder

    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

    Set objNS = Application.GetNamespace("MAPI")

    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

   ' MUST CHANGE THE OUTPUT FOLDER
   ' Assume this is a mail folder
    Set objFolder = GetFolder("10_Offline\_00_to_do")
    ' In case you would like to move to a subfolder in the inbox
    'Set objFolder = objInbox.Folders.Item("Done")


    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    End If

    If Application.ActiveExplorer.Selection.Count = 0 Then
        'Require that this procedure be called only when a message is selected
        Exit Sub
    End If

 
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.Move objFolder
            End If
        End If
    Next

    Set objItem = Nothing
    Set objFolder = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing

End Sub



Sub MoveSelectedMessagesToFolder()

On Error Resume Next
    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder

    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

    Set objNS = Application.GetNamespace("MAPI")

    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

   ' MUST CHANGE THE OUTPUT FOLDER
   ' Assume this is a mail folder
    Set objFolder = GetFolder("2009\Q4")
   


    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    End If

    If Application.ActiveExplorer.Selection.Count = 0 Then
         MsgBox "Nothing selected", vbOKOnly + vbExclamation, "No message selected"
        Exit Sub
    End If

 
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.Move objFolder
            End If
        End If
    Next

    Set objItem = Nothing
    Set objFolder = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing

End Sub


Public Function GetFolder(strFolderPath As String) As MAPIFolder
  ' folder path needs to be something like
  '   "Public Folders\All Public Folders\Company\Sales"
  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next

  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objFolder = objNS.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For I = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(I))
      If objFolder Is Nothing Then
        Exit For
      End If
    Next
  End If

  Set GetFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Function

Code Ends:
0
Comment
Question by:Medquest
  • 66
  • 64
  • 4
  • +1
135 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33461787
MOve calendar items between folders.

At the moment the script is locked to mailitems, and whilst this should be easy to open up, it also has teh folders embedded in teh script.  It may be simpler therefore simply to have a new script for the calendar item movements?

If this is ok then can you confirm the process i.e.:

For each item selectged in the current folder
    Check it's a calendar item
        Move it to a pre-defined folder
next

If yes then what is the path for the moveto folder ... and does it pre-exist ... (if so this simplifies the coding).

Chris
0
 

Author Comment

by:Medquest
ID: 33463306
Chris,
I agree with you.
I am trying to keep to folders in sync. one folder is stored on a PST file (sharepoint list) and the folder name for now let's just say Test Calendar, and then the other folder which is in the mailbox, which is let's say for now Smith, Joe and the folder name also Test Calendar.
 
normally the items will get to the one on the PST file, and need them to be copied to the one on the mailbox.
is this possible?
Thanks
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33463373
JUst for a moment can I continue to ignore the previous code:

What we can do is set an event handler so as soon as something is added to the 'first' folder it is copied to the 'second' one.

THis takes a trivial amount of code as long as all original posts goto the one folder.

Chris
0
 

Author Comment

by:Medquest
ID: 33463382
sure thing, let's forget about the previous code.
 
how can we create such an event handler?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33463471
There are three code components for each 'folder' as such, all code in thisOutlookSession:

1. INitialise a collection at the top of the module just after any option statements:

Private WithEvents olkCalendar As Outlook.items

2. Instantiate the collection in the outlook startup:

Private Sub Application_Startup()

    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items

End Sub

3. IMplement the chosen activity

Sub olkCalendar_ItemAdd(ByVal Item As Object)
dim itmCopy as object

    Set itmCopy = itm.Copy
    itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar).folders("CopyCal")

End Sub

Chris
0
 

Author Comment

by:Medquest
ID: 33463579
so what would be the final code based on the information I provided, which I am going to change folder names and such?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33463668
Not sure I follow so perhaps a clone will suggest the interpretation ... if not then can you rephrase what you need explaining:


Private WithEvents olkCalendar As Outlook.items

Private WithEvents olkInbox As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items

    Set olkInbox = Session.GetDefaultFolder(olFolderInbox).items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object

    Set itmCopy = itm.Copy

    itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar).folders("CopyCal")

End Sub



Sub olkInbox_ItemAdd(ByVal Item As Object)

dim itmCopy as object

    Set itmCopy = itm.Copy

    itmCopy.Move Application.Session.GetDefaultFolder(olFolder).folders("CopyInbox")

End Sub



 

Open in new window

0
 

Author Comment

by:Medquest
ID: 33463724
I am trying to keep 2 calendars in sync, where I would create an item in one of them and it would get copied to the other one, because the one in the mailbox can be seen in blackberry and the other one is stored in a PST and can ben seen only in outlook.
just like the 2 calendars you see in the attached image.

Calendar-Sync.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33463760
Can you pop the cursor onto the calendartestpst folder then in the BE immediate window, (ctrl + G to display it) enter:

?application.ActiveExplorer.CurrentFolder.FolderPath

Letting me know what it says?

Chris
0
 

Author Comment

by:Medquest
ID: 33464441
I am not really sure I understand what you're asking me to do :)
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33464540
You provided a snippet showing the calendars in teh outlook folders window.

In order to accurately capture that structure I need the folder path.  I can accurately get that from you via a bit of VBA.

1. IN outlook select the calendarTestPST folder.
2. IN outlook select the VBE using alt + F11
3. IN the VBE select the immediate window using ctrl + G
4. In the immediate window, (header bar immediate) place the line of code:
?application.ActiveExplorer.CurrentFolder.FolderPath
5. Select enter on the line and a string should be displayed ... copy that string here.

Chris
0
 

Author Comment

by:Medquest
ID: 33464732
I had to enable macros for this to work, and I hope it's what you were asking for.
Thanks
 
\\SharePoint Lists\CalendarTestPST
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33464843
The following should copy any entry in the calendar into that sharepoint folder.

Recall it's all located in thisOutlookSession and there should only be one copy.

Chris
Private WithEvents olkCalendar As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object

    Set itmCopy = itm.Copy

    itmCopy.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")



End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33464986
so do I need two macros one copyes from:
\\Mailbox - Smith, Joe\CalendarTestMBX
to
\\SharePoint Lists\CalendarTestPST and then the other one copys from:
\\SharePoint Lists\CalendarTestPST to \\Mailbox - Smith, Joe\CalendarTestMBX
to
\\SharePoint Lists\CalendarTestPST
 
so this way both folders will have the same contents?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33465110
Unless i'm missing teh point ... not a good idea to copy from a to b and b to a as well since each time an item is dropped in place the reverse process will occur.

But the text is slightly confusing and you might not mean that so can you double check what you said in the last post?
0
 

Author Comment

by:Medquest
ID: 33465135
I agree it's confusing, but the point I am trying to reach here is to keep the contents in both folders the same at all times, and that's why I was copying from A to B and then from B to A to achieve this goal.
is there a better way to do that?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33465429
I think we can do something with a hack ... let me think awhile.

Chris
0
 

Author Comment

by:Medquest
ID: 33465473
I really appreicate your help.
 
Thanks Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33467885
PAste the following sub into a normal code module.

Now Open a calendar item from the normal calendar and run the macro ... do you get a prompt true?

If so we can probably use this field to work with ... and we'll double check that later.

Chris
Sub addUSerProp()

Dim calItem As AppointmentItem



    Set calItem = Application.ActiveInspector.CurrentItem.Copy

    calItem.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    If Not hasProp(calItem, "CopyRecord") Then _

        calItem.UserProperties.Add "CopyRecord", olYesNo

    calItem.UserProperties("CopyRecord").Value = True

    MsgBox calItem.UserProperties("CopyRecord") = True

    

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33468047
I don't think it liked this all that much :)
Error1.jpg
Error2.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33468176
Oops .. should have included that ... post it into the same module.

Chris
Function hasProp(item As Object, strPropertyName As String) As Boolean

Dim prop As Variant



    For Each prop In item.UserProperties

        If LCase(prop.Name) = LCase(strPropertyName) Then

            hasProp = True

            Exit For

        End If

    Next

End Function

Open in new window

0
 

Author Comment

by:Medquest
ID: 33468255
Chris,
I've had a long day already and I amn not really sure what do you want me to do with the code now.
can you tell me again please?
 
Thanks
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33468432
add it after addUSerProp and run addUSerProp again:

Now Open a calendar item from the normal calendar and run the macro ... do you get a prompt true?

Chris
0
 

Author Comment

by:Medquest
ID: 33468701
I just tried this and I didn't get the prompt.
 
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33468785
Okay then, we can't use useproperties.  Tomorrow we'll try something else!

Chris
0
 

Author Comment

by:Medquest
ID: 33468810
sounds good.
thanks for all your help.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33468840
That said I have just tried a resequencing as perhaps it's version dependant.

Replace the previous sub addUSerProp with this new one and try again ... tomorrow is fine!

BTW which version of outlook are you using?

Chris


Sub addUSerProp()

Dim calItem As AppointmentItem



    Set calItem = Application.ActiveInspector.CurrentItem.Copy

    If Not hasProp(calItem, "CopyRecord") Then _

        calItem.UserProperties.Add "CopyRecord", olYesNo

    calItem.UserProperties("CopyRecord").Value = True

    calItem.Move Application.Session.GetDefaultFolder(olFolderCalendar).folders("copycal")

    MsgBox calItem.UserProperties("CopyRecord") = True

    

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33468857
I am running outlook 2010 and the client comupters are running 2007 (mostly)
could you please give me the exact steps I need to do to make this test as accurate as possible?
 
Thanks
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33468918
There was a bug in the last one so ...

1. Replace the current sub addUSerProp with this new one and then ...
2. Open a calendar item from the normal calendar and run the macro addUSerProp  ... do you get a prompt true?

Chris
Sub addUSerProp()

Dim calItem As AppointmentItem



    Set calItem = Application.ActiveInspector.CurrentItem.Copy

    If Not hasProp(calItem, "CopyRecord") Then _

        calItem.UserProperties.Add "CopyRecord", olYesNo

    calItem.UserProperties("CopyRecord").Value = True

    calItem.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    MsgBox calItem.UserProperties("CopyRecord") = True

    

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33469213
I get this error:
Compiler error:
Sub or Function not defined.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33469452
Did you delete hasProp?

Chris
Function hasProp(item As Object, strPropertyName As String) As Boolean

Dim prop As Variant



    For Each prop In item.UserProperties

        If LCase(prop.Name) = LCase(strPropertyName) Then

            hasProp = True

            Exit For

        End If

    Next

End Function

Open in new window

0
 

Author Comment

by:Medquest
ID: 33469503
no, I just used the same script you posted by copying and pasting.
was I supposed to delete something from before using it?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33469616
Not sure, you should one code module with the following, (delete any other code in the module):

Chris
Sub addUSerProp()

Dim calItem As AppointmentItem



    Set calItem = Application.ActiveInspector.CurrentItem.Copy

    If Not hasProp(calItem, "CopyRecord") Then _

        calItem.UserProperties.Add "CopyRecord", olYesNo

    calItem.UserProperties("CopyRecord").Value = True

    calItem.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    MsgBox calItem.UserProperties("CopyRecord") = True

    

End Sub



Function hasProp(item As Object, strPropertyName As String) As Boolean

Dim prop As Variant



    For Each prop In item.UserProperties

        If LCase(prop.Name) = LCase(strPropertyName) Then

            hasProp = True

            Exit For

        End If

    Next

End Function

Open in new window

0
 

Author Comment

by:Medquest
ID: 33469646
I see what you mean. ok I just did you got those an error message so I clicked on debug.
 

Error3.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33469760
Ah well that variant also works in 2007 as did the previous one so it must be something about 2010 perhaps to do with the inspector security, but unless we get a positive it isn't worth the effort of experimenting with changing the primary function of copying items.

I'll try to think of alternatives ... tomorrow, i'm outta here now.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33472404
Would it be ok to add some specific data into the body of the appointments ... something along the lines of <<autocopy:True>> for example

Chris
0
 

Author Comment

by:Medquest
ID: 33474601
is this only for testing or is it a requirement for the actual data? the reason I am asking is that I wil have no control over what users store on their calendars in outlook or sharepoint.
 
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33479460
IT's for real use as to prevent infinite loops we need a way to append a 'flag' to indicate an item does not need processing and since userproperties seemed to be disabled by your IT I have looked at the appointment properties and the first thought was the body since although we cannot say what is there the addition of a distinct token ought not affect what they do ... and if they delete it later then it is of no matter since it is only needed at the instant the appointment is copied over between folders.

Chris
0
 

Author Comment

by:Medquest
ID: 33486534
Chris,
I am the IT guy here and I don't think I disabled anything, so I am not sure what's going on. I am starting to even think about any application out there that might do this for me, but I can't find anything on the internet.
I am not saying that I am giving up or anything, but it's just a side thought.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33491621
>>> I can't find anything on the internet.
Makes me feel a clever so and so ;o)

If you haven't disabled anything we can:

a. try the userproperties approach
b. try the body edit ... but as soon as the 'alternate' copy kicks off use the existence of the flag to stop the copy and delete it as well so it has no real impact on users?

Chris
0
 

Author Comment

by:Medquest
ID: 33514883
Chris,
I know you're helping me here, but is it possible that you create a test PST file in your outlook, and then trying the tests right there?
this should save some time between the time you post the test and the time I perform the test, and then the time I respond back with the reslut.
is that ok?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33518079
I have done the tests already hence I know they work for my install ... the ealrier requests for you to try were t make sure they would work for you ... before making specific changes to the solution.

As a volunteer it is not my desire to make multiple attempts at solutions without some confidence that an approach will work hence the tests being requested of you and/or requests for a chosen approach.

Hopefully you now better understand the reason for the requests hence at the moment there are two possible approaches:

a. try the userproperties approach, (in case your test was invalid for some reason)
b. try the body edit ... but as soon as the 'alternate' copy kicks off use the existence of the flag to stop the copy and delete it as well so it has no real impact on users?

Chris
0
 

Author Comment

by:Medquest
ID: 33521153
I seem to have irritated you with my previous post, and for that I apologize.
ok can we pick from where we left?
how about we try with method A and see if we can get it work before moving on to B.
where do I start?
 
Thanks
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33521200
Sorry I wasn't clear.  We have already implemented a test on your system so option A has the least chance of success.

I suggest we roll with option B which ought to work and can be made transparent to the user(s) IMHO.

If that is agreed then there is nothing you need to do ... I think until I have implemented some code for the method.

Chris
0
 

Author Comment

by:Medquest
ID: 33521943
oh I got it. so you method B is the way to go but you're still working on the final code for it.
 
right?
 
Thanks
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33523684
I will now!

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33528457
I.m having some trouble creating a test so can you advise:

With the code in http:#33464986 for just 1 folder, does it copy the item to the alternate folder ok.

NOTE*******
Only do this for one folder as otherwise you will end up with a loop copying between the folders.

Chris
0
 

Author Comment

by:Medquest
ID: 33531670
Chris,
 
the goal here is as follows:
 
Folder1
 
Folder2
 
when an item is created / copied to Folder1, a copy of that item is copied to Folder2
when an item is created / copied to Folder2, a copy of that item is copied to Folder1
 
does this make sense?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33533938
I understan the requoirement and can implement as long as it works in one direction only.  i'm not getting it to work but I don't have external access so i'm hoping it's just a problem for me.

What I need in order to pursue the solution is the knowledge that with the code supplied at the start http:#33464843 it will work one way and if it does then I will append the checks and balances to prevent it looping infinitely.

Chris
0
 

Author Comment

by:Medquest
ID: 33534263
I am ready to test myself or provided whatever additional information you might need to make this happen.
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33534459
Just the knowledge that it copies something to the sharepoint folder without any errors will be enough for me to proceed.

Let me know how it goes.

Chris
0
 

Author Comment

by:Medquest
ID: 33534588
have you tested it on your side yet
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33534894
No, like I said i'm not able to do a thorough test.

Chris
0
 

Author Comment

by:Medquest
ID: 33534918
ok so I am ready to test it now, but with how many posts we have above, I am not sure which code to test or what steps to do to perform the test.
 
can you please copy the code again and tell me what steps I need to do?
 
Thanks
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33535338
0
 

Author Comment

by:Medquest
ID: 33535413
I selected the calendar under sharepoint, and then I hit Alt+F11, and then removed all the text there and pasted the one I copied from http:#33464843 and saved it.
 
I copied a calendar item to that calendar, but it didn't copy it to the other one.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33535520
Apologies, the code needs to be in thisoutlooksession if it wasn't put there and after doing restart outlook.

The original code there was to detect items dropped into the main calendar and copy them to the sharepoint calendar rather than the other way around.

I have added a check below to try and prevent any recurrence as i'm feeling a little paranoid about it!

Basically for any outlook session it will copy 1 item only.  Use this in thisoutlook session instead of the earlier code.

Chris
Private WithEvents olkCalendar As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object

Static bol As Boolean



    If Not bol Then

        Set itmCopy = itm.Copy

        itmCopy.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

        bol = True

    End If



End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33535658
I copied the above code, went to outlook, selected the caldendar in sharepoint list, hit alt+f11, removed all the code there and pasted the one I copied, closed outlook and save the project.
I opened outlook again, and then copied calendar items the calendar in sharepint list, and then checked the one in my mailbox and didn't see anything copied.
 
did I do anything wrong?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33539137
The code needs to be in thisoutlooksession, (elected the caldendar in sharepoint list, hit alt+f11, removed all the code there - you don't say if 'there' iis thisOutlookSession)

The original code there was to detect items dropped into the main calendar and copy them to the sharepoint calendar rather than the other way around, (copied calendar items the calendar in sharepint list).

Chris
0
 

Author Comment

by:Medquest
ID: 33540914
I am not sure where to look for thisOutlookSession) but as of now I am not seeing it.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33541100
In the project, expand "Microsoft Office Outlook Objects" and thiOutlookSession is in there.

Chris
0
 

Author Comment

by:Medquest
ID: 33541644
I just did, closed outlook, saved the project, and then when I opened outlook I got the error message in the attached image.
error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33543214
That code is in Module 1 i.e. a normal code module.  Note the earlier comment:

Delete it fom that module and place it in thisOutlookSession

"In the project, expand "Microsoft Office Outlook Objects" and thiOutlookSession is in there"

Chris
0
 

Author Comment

by:Medquest
ID: 33544372
ok so I did that and I now I am not getting any error message.
 
what should happen at this point?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33544407
When you drop an item in your normal calendar does it copy to the sharepoint folder ... restart outlook before you test it.

Chris
0
 

Author Comment

by:Medquest
ID: 33544483
looks like we're alomost there. when I created an appointment in my normal calendar I got an error and I clicked on debug so that you can see what's it about.
Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33544520
Typo

Set itmCopy = itm.Copy
to
Set itmCopy = item.Copy
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:Medquest
ID: 33569543
I am not sure what happened but I already tested the last code and seemed to work. I replied and told you that, but I am not seeing my reply here.
 
I applogize for that.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33569665
lol, it happens ... in my case I find it's gone into some question of no relevance to me at all.

Chri
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33569679
That being the case I guess I need to put something together with the checks and balances.  If you hear nothing in a couple of days - i've forgaotten so please remind me!

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33570177
OKay the following is an example for 1 folder copy ... basically does the copy occur still?

It is still limited to a copy from the main folder to the sharepoint folder and if it does then a clone of the code for the reverse path should complete things.

Chris
Private WithEvents olkCalendar As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    end if



End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33570717
since the one they'll be seeing is the one in the mailbox, can we make the copy happen from a calendar folder in the mailbox by the name of SharePointListMBX to the share point list in the PST?
 
the would be the ultimate and end solution :)
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33571236
Confused again.

As I understood the development you want to copy from the outlook folder to a sharepoint folder and for the reverse process to work as well.

The code I posted was for one direction which if(when) it proves viable will be scaled up with the reverse process as well.

How does this end solution relate to that understanding?

Chris
0
 

Author Comment

by:Medquest
ID: 33571390
that's exactly the same as I said, excepted you had a better wording that I am.
so here's how it should work.
a folder with the name of SharePointListMBX in the mailbox.
a folder with the name of share point list in the PST file, which gets created automatically when you connect to share point site.
the goal is to keep these two folders in sync.
I am hope I didn't confuse you even more :)
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33573032
To retry:

You want bi-directional synchronisation.

We have tested a form of uni directional synch and following that success I posted an enhanced form of that uni directional synch with a request for working confirmation.  Once that was confirmed I was going to add the reverse process at which point you posted your request in http:#33570717.

I will assume that as confirmation of the success therefore ...

Chris
Private WithEvents olkCalendar As Outlook.items

Private WithEvents olkSPCalendar As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items

    Set olkSPCalendar = Application.Session.folders("SharePoint Lists").folders("CalendarTestPST").items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    end if



End Sub



Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

    end if



End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33575956
good morning Chris,
 
I just tried it and got the error message and when I clicked on debug it had a highlighted line as you see in the attached image.

Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33576113
Step through and see where it actually fails

Chris
0
 

Author Comment

by:Medquest
ID: 33576182
it fails on the same line:
If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33577422
modifed to check type ... what happens now?

Chris
Private WithEvents olkCalendar As Outlook.items

Private WithEvents olkSPCalendar As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items

    Set olkSPCalendar = Application.Session.folders("SharePoint Lists").folders("CalendarTestPST").items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



if activeinspector.CurrentItem.class <> olappointment or activeinspector.CurrentItem.meetingstatus <> olnonmeeting then stop

    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    end if



End Sub



Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



if activeinspector.CurrentItem.class <> olappointment or activeinspector.CurrentItem.meetingstatus <> olnonmeeting then stop

    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

    end if



End Sub

 

Open in new window

0
 

Author Comment

by:Medquest
ID: 33577519
I got a different error this time.
Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33577626
How do you mean error ... does it pass to the stop command?

If so put the cursor over:
activeinspector.CurrentItem.class
then
activeinspector.CurrentItem.meetingstatus

What do they say?

Chris
0
 

Author Comment

by:Medquest
ID: 33577667
I am not sure what's going on but now it's working.
 
I created item in the default calendar and it was copied to the other one instantly.
0
 

Author Comment

by:Medquest
ID: 33588199
just wanted you to know that the new script would work the first time after I open outlook, but then it fails. it's not throuing an error or anything but it's just not copying the items.
 
Thanks
 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33589156
Can you set restart outlook so that it will process the action.  Now set a break point in the subs - I have added a stop command to both to do this.

Now when you drop an item, the sub will trigger and if you can step through the code letting me know the path it follows ... odds are there is an error occuring to throw the startup settings ... regardless of the lack of a reported error.

Chris
Private WithEvents olkCalendar As Outlook.items

Private WithEvents olkSPCalendar As Outlook.items



Private Sub Application_Startup()



    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items

    Set olkSPCalendar = Application.Session.folders("SharePoint Lists").folders("CalendarTestPST").items



End Sub





Sub olkCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



stop

if activeinspector.CurrentItem.class <> olappointment or activeinspector.CurrentItem.meetingstatus <> olnonmeeting then stop

    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.folders("SharePoint Lists").folders("CalendarTestPST")

    end if



End Sub



Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

dim itmCopy as object



stop

if activeinspector.CurrentItem.class <> olappointment or activeinspector.CurrentItem.meetingstatus <> olnonmeeting then stop

    if instr(1, item.body, "<<AutoCopy>>", vbTextCompare)>0 then

        item.body = replace(item.body, "<<AutoCopy>>", "", 1,, vbTextCompare)

        item.save

        exit sub

    else

        Set itmCopy = itm.Copy

        itmcopy.body = "<<AutoCopy>>"

        itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

    end if



End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33736147
I have dropped the ball on this one and for that I am sorry.
 
can we pick from where we left off?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33736158
Please do
0
 

Author Comment

by:Medquest
ID: 33736196
so this is the latest one I've been using, and it keeps poping up with debug windows everytime I accept an appointment:
===================================================================

Private WithEvents olkCalendar As Outlook.Items
Private WithEvents olkSPCalendar As Outlook.Items
Private Sub Application_Startup()
    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items
    Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items
End Sub

Sub olkCalendar_ItemAdd(ByVal Item As Object)
Dim itmCopy As Object
If ActiveInspector.CurrentItem.Class <> olAppointment Or ActiveInspector.CurrentItem.MeetingStatus <> olNonMeeting Then Stop
    If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then
        Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)
        Item.Save
        Exit Sub
    Else
        Set itmCopy = itm.Copy
        itmCopy.Body = "<<AutoCopy>>"
        itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")
    End If
End Sub
Sub olkSPCalendar_ItemAdd(ByVal Item As Object)
Dim itmCopy As Object
If ActiveInspector.CurrentItem.Class <> olAppointment Or ActiveInspector.CurrentItem.MeetingStatus <> olNonMeeting Then Stop
    If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then
        Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)
        Item.Save
        Exit Sub
    Else
        Set itmCopy = itm.Copy
        itmCopy.Body = "<<AutoCopy>>"
        itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)
    End If
End Sub
 
=================================================================
I'll see if I can have one of the guys here send me a meeting reqeust and see if I get the same error and if I so, I'll send you a copy  of the error.
 
Thanks
 
0
 

Author Comment

by:Medquest
ID: 33736232
here it is.
VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33736347
Try changing:

If ActiveInspector.CurrentItem.Class <> olAppointment Or ActiveInspector.CurrentItem.MeetingStatus <> olNonMeeting Then Stop
 
to

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub
 
Chris
0
 

Author Comment

by:Medquest
ID: 33737756
I tried this one so now I am not getting that error message anymore, but I am not seeing it copying the items to the other calendar.
0
 

Author Comment

by:Medquest
ID: 33737795
I take this back, I just got another error.
VBA-Error.jpg
0
 

Author Comment

by:Medquest
ID: 33737896
here's the latest error I've been getting.
 
I went over the script and changed any itm to item thinking it might be the problem, but that didn't help.

VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33737944
Twoi references to:
       Set itmCopy = itm.Copy
need to be
       Set itmCopy = item.Copy

Chris
Private WithEvents olkCalendar As Outlook.Items

Private WithEvents olkSPCalendar As Outlook.Items 

Private Sub Application_Startup() 

    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items

   Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items 

End Sub 



Sub olkCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If ActiveInspector.CurrentItem.Class <> olAppointment Or ActiveInspector.CurrentItem.MeetingStatus <> olNonMeeting Then Stop

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")

   End If 

End Sub 

Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If ActiveInspector.CurrentItem.Class <> olAppointment Or ActiveInspector.CurrentItem.MeetingStatus <> olNonMeeting Then Stop

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

   End If 

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33737972
I copied the entire script from your last and post and then tried and got an error.
VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33737997
Needed to re-assert the earlier 'change'

Chris
Private WithEvents olkCalendar As Outlook.Items

Private WithEvents olkSPCalendar As Outlook.Items 

Private Sub Application_Startup() 

    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items

   Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items 

End Sub 



Sub olkCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")

   End If 

End Sub 

Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

   End If 

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33744707
sorry for yesterday. we had a fire drill and I have to leav the building.
 
so I this is the error I am getting today.
 
Thanks Chris

VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33744994
i CHANGED THAT BACK TO THE FIX IN THE MOST RECENT POST!

cHRIS
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33744999
capslock! - sorry about that
0
 

Author Comment

by:Medquest
ID: 33745713
just tried it and got an error messag
VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33745779
WHat error message?
0
 

Author Comment

by:Medquest
ID: 33745901
the one in the screen shot.
what I also noticed is that even though it's throughing that error, it still moved the new item to the other calendar.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33746553
The code is breaking on that line ... if it was an error then there would be a message type box presenting the error.

Try closing outlook and re-opening anew.

Chris
0
 

Author Comment

by:Medquest
ID: 33747519
please see this screenshot for the exact error
VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33747806
In the VB Editor, try debug | clear all breakpoints and see what happens.

Chris
0
 

Author Comment

by:Medquest
ID: 33747836
what breakpoints are we talking about?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33748051
I don't know ... your problem appears to be the editor is breaking code execution.  IF there was an error it wouldn't progress past the line and there would be a specific message box referring to the error.

Hence I am wracking my brain to try and think what would cause it to break.  At this point for a given run time selecting all break points to be cleared will be a step one way or the other.

CHris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33768620
Don't know if we have already tried this but recheck anyway:

IN teh Visual BAsic Editor, (alt + F11 from the outlook app)

Select tools | References.
LOok for any entries with missing against them and if found uncheck them then retry.

Chris
0
 

Author Comment

by:Medquest
ID: 33769553
only 4 options selected as you can see in the attached image.

VBA-References.png
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33769589
And it still breaks?  .. have you tried a complte reboot?

Chris
0
 

Author Comment

by:Medquest
ID: 33769773
oh many times. I use my laptop at home and at work, so I have to shut it down to bring it to the office and then again to take it home.
 
what's interesting right now is that when I am testing it and create an item and see the debug message; it still moves the item I created to the other one.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33769827
WHat happens if you out either of the folder moves:

'Private WithEvents olkCalendar As Outlook.items
Private WithEvents olkSPCalendar As Outlook.items

Private Sub Application_Startup()

'    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).items
    Set olkSPCalendar = Application.Session.folders("SharePoint Lists").folders("CalendarTestPST").items

End Sub

and then vice versa
0
 

Author Comment

by:Medquest
ID: 33769892
I am not sure I understand what changes I need to make.
can you post the script with the first change, and then again with the second change?
 
Thanks Chris.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33769908
One
'Private WithEvents olkCalendar As Outlook.Items

Private WithEvents olkSPCalendar As Outlook.Items 

Private Sub Application_Startup() 

'    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items

   Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items 

End Sub 



Sub olkCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")

   End If 

End Sub 

Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

   End If 

End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33769914
Two
Private WithEvents olkCalendar As Outlook.Items

'Private WithEvents olkSPCalendar As Outlook.Items 

Private Sub Application_Startup() 

    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items

'   Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items 

End Sub 



Sub olkCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")

   End If 

End Sub 

Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

   End If 

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33769993
the first one didn't return any errors and didn't copy anything when testing, the second one returned the error you see in the attached image.
VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33770198
Did you try the copy the 'other' way around for the first example?  i.e. one was from main calendar to remote calendar and the other is the other way around

Chris
0
 

Author Comment

by:Medquest
ID: 33770558
I just did and got the attached error
VBA-Error.jpg
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33770852
Now try a dummy line to see if there is something in the command or just generic VBA

Chris
Private WithEvents olkCalendar As Outlook.Items

Private WithEvents olkSPCalendar As Outlook.Items 

Private Sub Application_Startup() 

    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items

   Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items 

End Sub 



Sub olkCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

debug.print now()

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")

   End If 

End Sub 

Sub olkSPCalendar_ItemAdd(ByVal Item As Object)

Dim itmCopy As Object 

debug.print now()

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

   If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then

       Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)

       Item.Save

       Exit Sub

   Else

       Set itmCopy = item.Copy

       itmCopy.Body = "<<AutoCopy>>"

       itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)

   End If 

End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33810447
I just tested it and the result is attached.
VBA-Error.jpg
0
 

Author Comment

by:Medquest
ID: 33879031
Chris,
 
I guess am calling it a quit, but I am not going to close the question and instead I am going to accept any of your answers since you've been trying to help me this long.
 
Thanks for trying.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33879317
bear with me whilst I refresh my memory of where this is ... I am concerned that I have not responded to a post from you.

Chris
0
 

Author Comment

by:Medquest
ID: 33880244
I don't think this is the case, but by looking at how long this thread is, I am thinking this may really not work unless you think otherwise.
 
again thanks a lot for your help with this.
0
 
LVL 59

Assisted Solution

by:Chris Bottomley
Chris Bottomley earned 200 total points
ID: 33881814
Try taking all the code in the module and pasting it into a text file.

Now delete all the code in the module and then paste it back from the text file ... just in case there are any stray control codes anywhere in the module itself.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33881841
I have also had a go at inviting other experts to assist with why the code keps breaking so hopefully someone will help us out on that concern.

Chris
0
 
LVL 35

Expert Comment

by:mvidas
ID: 33884483
Medquest,

Your recent screenshots show where the error is, but not what the error is. Is there any sort of pop-up window stating the error description (like there was in http:#33468047 in the first image), and if so what is the error text?

Matt
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33884936
MAtt

from my requests ... It's so much there is a fault in the code it's just that the VBE breaks on the line:

If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then exit sub

every time the code executes - no breakpoints set as far  as I have been able to ascertain but Medquest,
 can answer more definitively of course.

Chris
0
 
LVL 76

Accepted Solution

by:
David Lee earned 300 total points
ID: 33892773
Chris,

I believe the problem is that the code is going into an infinite loop.  When it copies the newly added appointment that creates an ItemAdd event on that calendar.  The new item triggers the ItemAdd event again which copies the new addition creating a new ItemAdd event and so on ad infinitum.  The solution is to disable event monitoring, copy the item, then re-enable event monitoring.  I've modified the code accordingly and it works fine for me.  
Private WithEvents olkCalendar As Outlook.Items
Private WithEvents olkSPCalendar As Outlook.Items

Private Sub Application_Startup()
    MonitorCalendar
    MonitorSPCalendar
End Sub

Sub olkCalendar_ItemAdd(ByVal Item As Object)
    Dim itmCopy As Object
    Debug.Print Now & vbTab & "Calendar"
    If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then Exit Sub
    If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then
        Debug.Print Now & vbTab & "Copy from SPCalendar"
        Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)
        Item.Save
        Exit Sub
    Else
        Debug.Print Now & vbTab & "Copy to SPCalendar"
        MonitorCalendar
        Set itmCopy = Item.Copy
        MonitorCalendar
        itmCopy.Body = "<<AutoCopy>>"
        itmCopy.Save
        itmCopy.Move Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST")
    End If
End Sub

Sub olkSPCalendar_ItemAdd(ByVal Item As Object)
    Dim itmCopy As Object
    Debug.Print Now() & vbTab & "SPCalendar"
    If Item.Class <> olAppointment Or Item.MeetingStatus <> olNonMeeting Then Exit Sub
    If InStr(1, Item.Body, "<<AutoCopy>>", vbTextCompare) > 0 Then
        Debug.Print Now & vbTab & "Copy from Calendar"
        Item.Body = Replace(Item.Body, "<<AutoCopy>>", "", 1, , vbTextCompare)
        Item.Save
        Exit Sub
    Else
        Debug.Print Now & vbTab & "Copy to Calendar"
        MonitorSPCalendar
        Set itmCopy = Item.Copy
        MonitorSPCalendar
        itmCopy.Body = "<<AutoCopy>>"
        itmCopy.Save
        itmCopy.Move Application.Session.GetDefaultFolder(olFolderCalendar)
    End If
End Sub

Sub MonitorCalendar()
    If TypeName(olkCalendar) = "Nothing" Then
        Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items
    Else
        Set olkCalendar = Nothing
    End If
End Sub

Sub MonitorSPCalendar()
    If TypeName(olkSPCalendar) = "Nothing" Then
        Set olkSPCalendar = Application.Session.Folders("SharePoint Lists").Folders("CalendarTestPST").Items
    Else
        Set olkSPCalendar = Nothing
    End If
End Sub

Open in new window

0
 

Author Comment

by:Medquest
ID: 33894107
that did the trick and it worked beautifully.
 
Thanks a lot guys.
0
 

Author Closing Comment

by:Medquest
ID: 33894119
excellent.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 33894167
Cool.  Glad it worked.  Chris deserves the majority of the credit, not me.  I just helped solve one problem.
0
 

Author Comment

by:Medquest
ID: 33894376
BlueDevilFan,
 
I am not sure if this is by design or not. ok so when I create an appointment on either one it gets copied to the other one, but when I delete it, it's not getting deleted from the other one.
 
is something something else we need to add for it to update each other everytime there's a change?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33894782
Cheers David, intersting way to stop the event firing!

Chris
0
 
LVL 76

Expert Comment

by:David Lee
ID: 33896224
Deleting is a real problem, one that's not easily handled.  While an event (ItemRemove) is triggered when an item is deleted from a folder the event procedure doesn't know which item was deleted.  It just knows that something has been removed.  There are two ways to handle this, neither of them especially simple or pretty.  First, write code for the ItemRemove event that does an item by item comparison of the target folder to the source folder (i.e. the item was removed from).  For each item in the target folder search the source folder to see if it exists there.  If there's no match, then that's the item that was deleted so delete it here too.  Of course this creates a performance hit that gets more pronounced as the number of items in the folder gets larger.  If there are 1,000 items in each calendar and you delete 5 of them, then the code has to read 1,000 + 999 + 998 + 997 + 996 items.  In otehr words, don't expect it to be fast.  The second solution, writing an explorer wrapper, eliminates this issue but is much more complicated to produce.  An explorer wrapper is a class module that keeps track of each explorer window and each open item.  This allows the code to trap the delete event for an item instead of the folder's ItemRemove event.  This allows you to know exactly which item is being deleted so you can delete the same item from the opposing folder.  You can do this without writing a wrapper, but it will fail if you ever open more than one item at a time, ever switch between open items, or open more than one explorer window.  The problem is that VBA does not have built-in support for an array of objects.  You have to craft your own.  

There are other problems too, including one that you may not have thought of yet.  Outlook items don't have a globally unique identifier so finding an item can be dicey.  For example, assume that you just deleted one instance of an appointment titled "Weekly Project Meeting" and the code now needs to find and delete that same meeting from the other calendar.  How will it find a match?  It can't use the subject alone since there are other appointments with the same title.  Of course you can use a combination of subject and start/end times, but that's not as simple as it could be.  The other issue, the one you may have overlooked, is changes.  The code you have now copies new items, and you've asked about deleting items, but if the goal is to keep the items in sync, then you have to consider changes too.  That means trapping another event and again having to find the matching item and change it too.

The bottom line to this is that coding a process to keep any two folders in sync is NOT a simple task.  It would be really nice if Microsoft would expose the objects that do this without the need to write any code.  The capability is already there as evidenced by the fact that Outlook can sync with the Exchange server and with a Sharepoint folder.  
0
 

Author Comment

by:Medquest
ID: 33896988
well, you guys went above and beyound the extra mile to help with this issue and sometimes it just gets to the point where we say "it is what it is" and there's nothing we can do about it.
 
thanks to everyone.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 33897543
You're welcome.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Create high volume marketing opportunities using email signatures with these top 10 DOs and DON'Ts of email signature marketing.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
The viewer will learn how to use and create new code templates in NetBeans IDE 8.0 for Windows.

757 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now