Solved

Business Contact Manager Sync to local contacts folder.

Posted on 2009-07-07
33
1,017 Views
Last Modified: 2013-11-25
Hi,

I am looking for a utility to replace OutlookPCS. It is a small Outlook add in that copies contacts from any public folders you specify into your own contacts folder. The sync is only one way and if you modify any of the items in your own contacts folder by mistake your changes are over written with the record from the public folder next time you sync - but thats OK, you just need to remember to edit the contact records in the public folder - not in your own mailbox contacts folder and I have applied a filter when looking at my own contacts folder which excludes stuff synchronised from elsewhere so I do not change the detail by mistake.

The reason we are looking for something more sophisticated is that we now use outlook BCM to manage our shared contacts, and we've gone from having about 100 records to over 600. These are sorted by Category, and all the ones I want to sync have one specific category but OutlookPCS just syncs the whole lot, it doesnt allow you to specify only to sync contacts with a specific category. As I then go on to sync over the air to a mobile device from my local contacts folder I do not want to have lots of records I do not need in there.

So the question is, does anyone know of anything or is anyone able to write some code for us that will basically do the following:

1. Go through all contacts in an Exchange Business Contacts manager folder.
2. Take any of them which have a specific category of "Rob Sync" and if they are not there already copy them to my personal contacts folder.
3. If they are there already and the detail has changed on the Business Contacts Manager then overwrite the one in my contacts folder with the new record (or changes).
4. If there are items in my contacts folder that have been copied from BCM and they now no longer exist in BCM folder (assumably deleted) then also delete them from my contacts folder.
5. Finally -  its important not to do anything to contacts in my personal contacts folder that are not synchronised from BCM as these are my personal contact records - nothing to do with BCM or public contacts etc.

I have looked at modifying the attached code I found in a thread which BlueDevilFan kindly posted to answer another question - but am not familiar enough with Outlook to be able to do it very easily.

Any ideas would be appreciated,

Thanks

Rob

'Code Begins Here

Sub SyncContacts()

    Dim objLocalFolder As MAPIFolder, _

        objSharedFolder As MAPIFolder, _

        objContact As ContactItem, _

        objContactCopy As ContactItem, _

        intIgnored As Integer, _

        intCreatedShared As Integer, _

        intCreatedLocal As Integer, _

        intSyncLocal As Integer, _

        intSyncShared As Integer

    'The local folder is the default contacts folder

    'Set objLocalFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

    Set objLocalFolder = OpenMAPIFolder("\Mailbox - Rob Hammond\atest")

    'Edit the path to the shared folder as needed

    Set objSharedFolder = OpenMAPIFolder("\Business Contact Manager\Accounts")

    

    

    For Each objContact In objLocalFolder.Items

        'Is this item is not marked private and if it is a contact

        If objContact.Sensitivity <> olPrivate And objContact.Class = olContact Then

            Set objContactCopy = objSharedFolder.Items.Find("[FileAs] = " & Chr(34) & objContact.FileAs & Chr(34))

            'Did we find a match

            If Not IsNothing(objContactCopy) Then

                'Have the contacts been synced before?

                If IsDate(objContact.User4) And IsDate(objContactCopy.User4) Then

                    'Has the local contact changed and, if so, is it newer than the matching shared contact

                    If (DateDiff("s", CDate(objContact.User4), objContact.LastModificationTime) > 5) And (objContact.LastModificationTime > objContactCopy.LastModificationTime) Then

                        'Copy from local to shared

                        'ContactCopy objContact, objContactCopy

                        'intSyncShared = intSyncShared + 1

                    Else

                        'Has the shared contact changed and, if so, is it newer than the matching local contact

                        If (DateDiff("s", CDate(objContactCopy.User4), objContactCopy.LastModificationTime) > 5) And (objContactCopy.LastModificationTime > objContact.LastModificationTime) Then

                            'Copy from shared to local

                            ContactCopy objContactCopy, objContact

                            intSyncLocal = intSyncLocal + 1

                        End If

                    End If

                Else

                    'Is the local contact newer than the shared contact

                    If objContact.LastModificationTime > objContactCopy.LastModificationTime Then

                        'Copy from local to shared

                        'ContactCopy objContact, objContactCopy

                        'intSyncShared = intSyncShared + 1

                    Else

                        'Then the shared contact must be newer than the local contact

                        'Copy from shared to local

                        ContactCopy objContactCopy, objContact

                        intSyncLocal = intSyncLocal + 1

                    End If

                End If

            Else

                'There was no match so copy the entire contact to the shared folder

                'objContact.User4 = CStr(Now())

                'objContact.Save

                'Set objContactCopy = objContact.Copy

                'objContactCopy.Move objSharedFolder

                'intCreatedShared = intCreatedShared + 1

            End If

        Else

            intIgnored = intIgnored + 1

        End If

    Next

    

    

    For Each objContact In objSharedFolder.Items

        Set objContactCopy = objLocalFolder.Items.Find("[FileAs] = " & Chr(34) & objContact.FileAs & Chr(34))

        'If we didn't find a matching contact in the local folder

        If IsNothing(objContactCopy) Then

            'Copy the entire contact from the shared folder to the local folder

            objContact.User4 = CStr(Now())

            objContact.Save

            Set objContactCopy = objContact.Copy

            objContactCopy.Move objLocalFolder

            intCreatedLocal = intCreatedLocal + 1

        End If

    Next

    

    

    MsgBox " Items Ignored: " & intIgnored & vbCrLf & _

           "    New Shared: " & intCreatedShared & vbCrLf & _

           "Sync to Shared: " & intSyncShared & vbCrLf & _

           "     New Local: " & intCreatedLocal & vbCrLf & _

           " Sync to Local: " & intSyncLocal, vbInformation, "Syncronization Summary"

    Set objContact = Nothing

    Set objContactCopy = Nothing

    Set objLocalFolder = Nothing

    Set objSharedFolder = Nothing

End Sub
 

Private Sub ContactCopy(objSourceItem As ContactItem, objDestItem As ContactItem)

    With objSourceItem

        objDestItem.Account = .Account

        objDestItem.Anniversary = .Anniversary

        objDestItem.AssistantName = .AssistantName

        objDestItem.AssistantTelephoneNumber = .AssistantTelephoneNumber

        objDestItem.BillingInformation = .BillingInformation

        objDestItem.Birthday = .Birthday

        objDestItem.Body = .Body

        objDestItem.Business2TelephoneNumber = .Business2TelephoneNumber

        objDestItem.BusinessAddress = .BusinessAddress

        objDestItem.BusinessAddressCity = .BusinessAddressCity

        objDestItem.BusinessAddressCountry = .BusinessAddressCountry

        objDestItem.BusinessAddressPostalCode = .BusinessAddressPostalCode

        objDestItem.BusinessAddressPostOfficeBox = .BusinessAddressPostOfficeBox

        objDestItem.BusinessAddressState = .BusinessAddressState

        objDestItem.BusinessAddressStreet = .BusinessAddressStreet

        objDestItem.BusinessFaxNumber = .BusinessFaxNumber

        objDestItem.BusinessHomePage = .BusinessHomePage

        objDestItem.BusinessTelephoneNumber = .BusinessTelephoneNumber

        objDestItem.CallbackTelephoneNumber = .CallbackTelephoneNumber

        objDestItem.CarTelephoneNumber = .CarTelephoneNumber

        objDestItem.Categories = .Categories

        objDestItem.Children = .Children

        objDestItem.Companies = .Companies

        objDestItem.Department = .Department

        objDestItem.Email1Address = .Email1Address

        objDestItem.Email1AddressType = .Email1AddressType

        objDestItem.Email1DisplayName = .Email1DisplayName

        objDestItem.Email2Address = .Email2Address

        objDestItem.Email2AddressType = .Email2AddressType

        objDestItem.Email2DisplayName = .Email2DisplayName

        objDestItem.Email3Address = .Email3Address

        objDestItem.Email3AddressType = .Email3AddressType

        objDestItem.Email3DisplayName = .Email3DisplayName

        objDestItem.FileAs = .FileAs

        objDestItem.FTPSite = .FTPSite

        objDestItem.FullName = .FullName

        objDestItem.Gender = .Gender

        objDestItem.GovernmentIDNumber = .GovernmentIDNumber

        objDestItem.Hobby = .Hobby

        objDestItem.Home2TelephoneNumber = .Home2TelephoneNumber

        objDestItem.HomeAddress = .HomeAddress

        objDestItem.HomeAddressCity = .HomeAddressCity

        objDestItem.HomeAddressCountry = .HomeAddressCountry

        objDestItem.HomeAddressPostalCode = .HomeAddressPostalCode

        objDestItem.HomeAddressPostOfficeBox = .HomeAddressPostOfficeBox

        objDestItem.HomeAddressState = .HomeAddressState

        objDestItem.HomeAddressStreet = .HomeAddressStreet

        objDestItem.HomeFaxNumber = .HomeFaxNumber

        objDestItem.HomeTelephoneNumber = .HomeTelephoneNumber

        objDestItem.IMAddress = .IMAddress

        objDestItem.Importance = .Importance

        objDestItem.Initials = .Initials

        objDestItem.InternetFreeBusyAddress = .InternetFreeBusyAddress

        objDestItem.ISDNNumber = .ISDNNumber

        objDestItem.JobTitle = .JobTitle

        objDestItem.Language = .Language

        objDestItem.LastName = .LastName

        objDestItem.MailingAddress = .MailingAddress

        objDestItem.MailingAddressCity = .MailingAddressCity

        objDestItem.MailingAddressCountry = .MailingAddressCountry

        objDestItem.MailingAddressPostalCode = .MailingAddressPostalCode

        objDestItem.MailingAddressPostOfficeBox = .MailingAddressPostOfficeBox

        objDestItem.MailingAddressState = .MailingAddressState

        objDestItem.MailingAddressStreet = .MailingAddressStreet

        objDestItem.ManagerName = .ManagerName

        objDestItem.MiddleName = .MiddleName

        objDestItem.Mileage = .Mileage

        objDestItem.MobileTelephoneNumber = .MobileTelephoneNumber

        objDestItem.NetMeetingAlias = .NetMeetingAlias

        objDestItem.NetMeetingServer = .NetMeetingServer

        objDestItem.NickName = .NickName

        objDestItem.OfficeLocation = .OfficeLocation

        objDestItem.OrganizationalIDNumber = .OrganizationalIDNumber

        objDestItem.OtherAddress = .OtherAddress

        objDestItem.OtherAddressCity = .OtherAddressCity

        objDestItem.OtherAddressCountry = .OtherAddressCountry

        objDestItem.OtherAddressPostalCode = .OtherAddressPostalCode

        objDestItem.OtherAddressPostOfficeBox = .OtherAddressPostOfficeBox

        objDestItem.OtherAddressState = .OtherAddressState

        objDestItem.OtherAddressStreet = .OtherAddressStreet

        objDestItem.OtherFaxNumber = .OtherFaxNumber

        objDestItem.OtherTelephoneNumber = .OtherTelephoneNumber

        objDestItem.PagerNumber = .PagerNumber

        objDestItem.PersonalHomePage = .PersonalHomePage

        objDestItem.PrimaryTelephoneNumber = .PrimaryTelephoneNumber

        objDestItem.Profession = .Profession

        objDestItem.RadioTelephoneNumber = .RadioTelephoneNumber

        objDestItem.ReferredBy = .ReferredBy

        objDestItem.SelectedMailingAddress = .SelectedMailingAddress

        objDestItem.Sensitivity = .Sensitivity

        objDestItem.Spouse = .Spouse

        objDestItem.Subject = .Subject

        objDestItem.Suffix = .Suffix

        objDestItem.TelexNumber = .TelexNumber

        objDestItem.Title = .Title

        objDestItem.TTYTDDTelephoneNumber = .TTYTDDTelephoneNumber

        objDestItem.User1 = .User1

        objDestItem.User2 = .User2

        objDestItem.User3 = .User3

        objDestItem.WebPage = .WebPage

        'Don't delete or edit the code between here and End Sub

        objDestItem.User4 = CStr(Now())

        objDestItem.Save

        .User4 = CStr(Now())

        .Save

    End With

End Sub
 

'Credit where credit is due.

'The code below is not mine.  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(szPath)

    Dim app, ns, flr, szDir, i

    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

End Function
 

Function IsNothing(Obj)

  If TypeName(Obj) = "Nothing" Then

    IsNothing = True

  Else

    IsNothing = False

  End If

End Function

'Code Ends Here

Open in new window

0
Comment
Question by:robham
  • 17
  • 13
33 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 24819862
Hi, robham.

Here's one possible solution.  The code comes in two parts.  This is part one.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  Right-click on Class Modules, select Insert > Class Module
5.  In the Properties panel click on Name and enter SyncContacts
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor


Option Explicit
 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"
 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String
 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property
 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property
 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property
 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.subject = "Synchronization Run - " & Now

    For Each olkItem In olkSource.Items

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    Set olkMatch = olkItem.Copy

                    olkMatch.Move olkTarget

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    If olkItem.LastModificationTime > olkMatch.LastModificationTime Then

                        olkMatch.Delete

                        Set olkMatch = olkItem.Copy

                        olkMatch.Move olkTarget

                        lngSynced = lngSynced + 1

                        WriteToLog olkItem.FullName & " (Synced)"

                    End If

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub
 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 
LVL 76

Expert Comment

by:David Lee
ID: 24819901
This is part two.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor
10. Run the SynchronizeContacts macro to sync the contacts

Please test this using sample data before using with production data.
Sub SynchronizeContacts()

    Dim objSC As New SyncContacts

    With objSC

        'Edit the folder path on the next two lines'

        Set .Source = OpenOutlookFolder("Business Contact Manager\Business Contacts")

        Set .Target = OpenOutlookFolder("Mailbox - Rob\Contacts")

        'Edit the category name on the next line'

        .Category = "Rob Sync"

        .Sync

    End With

    Set objSC = Nothing

End Sub
 

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder

    ' Purpose: Opens an Outlook folder from a folder path.'

    ' Written: 4/24/2009'

    ' Author:  BlueDevilFan'

    ' Outlook: All versions'

    Dim arrFolders As Variant, _

        varFolder As Variant, _

        bolBeyondRoot As Boolean

    On Error Resume Next

    If strFolderPath = "" Then

        Set OpenOutlookFolder = Nothing

    Else

        Do While Left(strFolderPath, 1) = "\"

            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)

        Loop

        arrFolders = Split(strFolderPath, "\")

        For Each varFolder In arrFolders

            Select Case bolBeyondRoot

                Case False

                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)

                    bolBeyondRoot = True

                Case True

                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)

            End Select

            If Err.Number <> 0 Then

                Set OpenOutlookFolder = Nothing

                Exit For

            End If

        Next

    End If

    On Error GoTo 0

End Function

Open in new window

0
 
LVL 76

Expert Comment

by:David Lee
ID: 24855468
Rob,

There may be a problem with part 1.  Please replace the code in that post with the code below.
Option Explicit
 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"
 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String
 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property
 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property
 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property
 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.Display

    olkLog.Subject = "Synchronization Run - " & Now

    For lngIndex = olkSource.Items.count To 1 Step -1

        Set olkItem = olkSource.Items.Item(lngIndex)

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    Set olkMatch = olkItem.Copy

                    olkMatch.Move olkTarget

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    If olkItem.LastModificationTime > olkMatch.LastModificationTime Then

                        olkMatch.Delete

                        Set olkMatch = olkItem.Copy

                        olkMatch.Move olkTarget

                        lngSynced = lngSynced + 1

                        WriteToLog olkItem.FullName & " (Synced)"

                    End If

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub
 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 

Author Comment

by:robham
ID: 24894992
Hi BlueDevilFan,

Sorry to bring bad news but I still cant get it to sync contacts and the post screen is blank. It stops the code on the .Sync line.

any ideas?

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24900464
Rob,

Please replace the code in the class module with the version below and test again.  I'm thinking that the problem is rooted in the way BCM works.  The code as I posted above works perfectly with pure Outlook.  I don't use or have access to BCM so I'm not familiar with how it works.  
Option Explicit
 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"
 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String
 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property
 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property
 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property
 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date, _

        dicItems As Object, _

        arrItems As Variant, _

        varItem As Variant

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.Display

    olkLog.Subject = "Synchronization Run - " & Now

    Set dicItems = CreateObject("Scripting.Dictionary")

    For lngIndex = olkSource.Items.count To 1 Step -1

        Set olkItem = olkSource.Items.Item(lngIndex)

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    'Set olkMatch = olkItem.Copy

                    'olkMatch.Move olkTarget

                    dicItems.Add olkItem.EntryID, olkItem.EntryID

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    If olkItem.LastModificationTime > olkMatch.LastModificationTime Then

                        olkMatch.Delete

                        'Set olkMatch = olkItem.Copy

                        'olkMatch.Move olkTarget

                        dicItems.Add olkItem.EntryID, olkItem.EntryID

                        lngSynced = lngSynced + 1

                        WriteToLog olkItem.FullName & " (Synced)"

                    End If

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    arrItems = dicItems.Items()

    For Each varItem In arrItems

        Set olkMatch = Session.GetItemFromID(varItem).Copy

        olkMatch.Move olkTarget

        Set olkMatch = Nothing

    Next

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub
 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 

Author Comment

by:robham
ID: 24902201
Thanks, looks like we are a step closer. When I run it now it takes much longer, and adds three entries to the log (one for each of the contacts I have in the sync category).

But then it still stops with the same error as before on the .Sync line.

Looks much more promising though.

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24902464
The three entries it added, are these the only three contacts in BCM that match the category?  Also, did it copy the contacts?
0
 

Author Comment

by:robham
ID: 24902840
Yes the three it listed are the only three with that category on them for the moment, so this is correct.

No it did not copy them to the Mailbox contacts folder.

Just to prove a point, if I right click the contact in BCM and drag it to my contact folder, and click copy it copies it across OK.

Not sure if it has any bearing but I have also checked the names and they are unique ie if it is trying to copy a contact called John Smith from BCM I have made sure there is no contact called John Smith in my contacts folder.

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24906211
Just needed to know if it copied them so I could make an educated guess at where the error occurred.  Must have been line 72.  Apparently BCM doesn't implement EntryIDs.  EntryID as a unique identifier given to each Outlook item.  Apparently BCM doesn't implement it.  Back to the drawing board.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24910804
Replace the code in the class module with the version below.
Option Explicit
 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"
 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String
 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property
 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property
 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property
 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date, _

        dicItems As Object, _

        arrItems As Variant, _

        varItem As Variant

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.Display

    olkLog.Subject = "Synchronization Run - " & Now

    Set dicItems = CreateObject("Scripting.Dictionary")

    For lngIndex = olkSource.Items.count To 1 Step -1

        Set olkItem = olkSource.Items.Item(lngIndex)

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    'Set olkMatch = olkItem.Copy

                    'olkMatch.Move olkTarget

                    dicItems.Add olkItem.FileAs, olkItem.FileAs

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    If olkItem.LastModificationTime > olkMatch.LastModificationTime Then

                        olkMatch.Delete

                        'Set olkMatch = olkItem.Copy

                        'olkMatch.Move olkTarget

                        dicItems.Add olkItem.FileAs, olkItem.FileAs

                        lngSynced = lngSynced + 1

                        WriteToLog olkItem.FullName & " (Synced)"

                    End If

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    arrItems = dicItems.Items()

    For Each varItem In arrItems

        Set olkItem = olkSource.Items.Find("[FileAs] = '" & Replace(varItem, "'", "''") & "'")

        Set olkMatch = olkItem.Copy

        olkMatch.Move olkTarget

        Set olkMatch = Nothing

        Set olkItem = Nothing

    Next

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub
 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 

Author Comment

by:robham
ID: 24949980
Hi, Sorry for the delay in coming back to you - for some reason I didnt get an email to say the thread was updated.

I have tried replacing the code as above and it looks to give exactly the same result:

After listing the three contacts that meet the criteria it then stops with:

Run-time error '-2147221246 (80040102)':

Could not complete the operation because the service provider does not support it.

When I click debug it highlights the .Sync line of code.

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24956263
No problem, Rob.

Try setting a breakpoint on line 70 then running the code again.  When execution gets to line 78 Outlook will pause and display the VB editor with line 70 highlighted.  Pressing F8 will execute the current line and move forward one line.  Step through the code until it generates the error.  I need to know which line the code fails on.
0
 

Author Comment

by:robham
ID: 24959237
Hiya,

I am learning alot about VBA!

I set the breakpoint on line 70 - it highlighted it in red. Then ran the code and it stopped with line 70 highlighted in yellow. I pressed f8 three times and all was OK until then, line 73 was highlighted in yellow "Set olkMatch = olkItem.Copy" and when I pressed f8 with that line highlighted it came up with the error.

Hope that is correct?

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24963946
Based on that error I have to say that this now appears impossible.  Apparently there is no way to copy a BCM contact using code.  The only solution would be to copy data property by property instead of copying the entire contact.  But, that brings up another insurmountable problem.  Some properties are read-only.  I can copy them, but I can't set the value in the copy.  For example, Say that Mr. Jones is a new BCM contact.  I create a new blank contact in your contacts, then read Mr Jones BCM contact and copy the data one property at a time to the new contact.  This will work okay until I hit a read-only field.  I'll be able to read it from Mr. Jones contact, but won' tbe able to set the value in the new contact because it is read-only.  I'll have to look at a contact's properties to determine which ones are read-only.  Maybe there won't be any that are important.  
0
 

Author Comment

by:robham
ID: 24967886
Hi David,

That sounds like quite a problem then. When it copies the contact does it try and copy it in the same folder (ie the BCM folder?) this may be the problem as each contact in the BCM is unique and has unique identifiers so that it can be tied to other items. For example you have company entries and contact entries. Each contact entry has a parent company ID field which ties it back to the Company the contact is associated to.
Obviously this would be a problem if we were thinking about two way synchronisation, but I was hoping just to get the basic Telephone numbers, name, company name and address across to the local contacts folder with maybe the contact picture as well if possible.

Rob

0
The curse of the end user strikes again      

You’ve updated all your end user’s email signatures. Hooray! But guess what? They’re playing around with the HTML, adding stupid taglines and ruining the imagery. Find out how you can save your signatures from end users today.

 
LVL 76

Expert Comment

by:David Lee
ID: 24968468
G'morning, Rob.

Yes, it copies it in the same folder.  Unfortuntaely there's no "copyto" command for individual items.  There is for a folder, so one solution might be to copy the entire folder to Outlook, sync, and delete the temp folder.  Assuming of course that the CopyTo works for a BCM folder.  For individual items the way to copy them to a folder is to Copy then Move.  
0
 

Author Comment

by:robham
ID: 24968480
OK - how about I try and copy all of the BCM contacts into a regular outlook contacts folder and then run the syncronisation macro on the regular outlook contacts folder?

I will give this a try and let you know results.

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24968500
That's a good test.
0
 

Author Comment

by:robham
ID: 24968617
Hi David, This has actually worked and copied the contacts over into the personal contacts folder.
However it crashes around line 84 I think on the third time it goes through that loop. There are just three contacts at the moment.
It says Runtime error - the item has been moved or deleted.

I guess this does give me a solution but I couldnt really roll this out to the others - it is a bit too technical. Also I guess if you are copying over all the contacts from one folder to another then why not just filter the view to include ones of a certain catagory and copy them straight into your contacts folder directly - ah just remembered why - it creates duplicates each time you do this.

I am gradually understanding the code - would it be a lot of work to point me in the right direction by giving me something that would just create a new contact with the company name say and then leave me to work out how to read and write all the other fields we need?

Thanks for all your help, it really is appreciated!

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 25029302
Hey, Rob.

Sorry to be slow answering.  I've modified the code to create a blank item and copy the source item's properties rather than copy the item itself.  This won't be the same as copying the original item since it's impossible to copy any read-only properties using this approach.  However, it will copy the key properties.  Please replace the class module with the code below and run another test.
Option Explicit

 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"

 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String

 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property

 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property

 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property

 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.Subject = "Synchronization Run - " & Now

    olkLog.Body = ""

    olkLog.Display

    For Each olkItem In olkSource.Items

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    Set olkMatch = olkTarget.Items.Add()

                    On Error Resume Next

                    For Each olkProp In olkItem.ItemProperties

                        If olkProp.Type <> olOutlookInternal Then

                            olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value

                        End If

                    Next

                    On Error GoTo 0

                    olkMatch.Save

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    If olkItem.LastModificationTime > olkMatch.LastModificationTime Then

                        For Each olkProp In olkItem.ItemProperties

                            If olkProp.Type <> olOutlookInternal Then

                                olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value

                            End If

                        Next

                        lngSynced = lngSynced + 1

                        WriteToLog olkItem.FullName & " (Synced)"

                    End If

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub

 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 

Author Comment

by:robham
ID: 25058339
Hiya David, also sorry to take some time to test this, I was away for the weekend and only got back this morning.

Seems like progress!

it now identifies the three contacts I have chosen lists them in the post window and also copies them to my personal contacts folder. it then gives an error saying "The item has been moved or deleted" on the .Sync line.

Out of interest I modified the telephone numbers in the source contact and ran the sync again and noticed that it did not overwrite the ones in the personal contacts folder is this a limitation of the new method of creating contacts?

Thanks again for all the help with this.

Rob
0
 

Author Comment

by:robham
ID: 25631890
Hi All,

I am still looking for a solution to the problem - the code Blue Devil fan has created almost works, but errors out at the .Sync line and only works once, ie if you change something in the BCM contacts it does not update it in the personal contacts folder.

If anyone is able to solve these two problems then we would be most grateful as we are still looking for a solution and no commerical packages seem to be available to do this.

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 25659232
Rob,

Apologies.  I lost track of this question.  I'll get back to work on it.

EE, please leave this question open.  
0
 
LVL 76

Expert Comment

by:David Lee
ID: 25668582
Rob,

Please replace the code you have now with the version below.  Test it again and let me know what happens.
Option Explicit

 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"

 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String

 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property

 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property

 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property

 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.Subject = "Synchronization Run - " & Now

    olkLog.Body = ""

    olkLog.Display

    For Each olkItem In olkSource.Items

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    Set olkMatch = olkTarget.Items.Add()

                    On Error Resume Next

                    For Each olkProp In olkItem.ItemProperties

                        If olkProp.Type <> olOutlookInternal Then

                            olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value

                        End If

                    Next

                    On Error GoTo 0

                    olkMatch.Save

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    For Each olkProp In olkItem.ItemProperties

                        If olkProp.Type <> olOutlookInternal Then

                            olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value

                        End If

                    Next

                    olkMatch.Save

                    lngSynced = lngSynced + 1

                    WriteToLog olkItem.FullName & " (Synced)"

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub

 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 

Author Comment

by:robham
ID: 25674803
Hi BDF,

Thanks for coming back to this question.

I have replaced the code with the sample above and when I run it, a new empty window appears and quite quickly I get:

Run-time error '-1699610615 (9ab200009)':
Property is read-only.

When I press debug it is stopped on the .Sync line.

No other messages come up and as far as I can see no contacts are created in the local folder.

Rob
0
 
LVL 76

Expert Comment

by:David Lee
ID: 25675356
Ok, try this version.
Option Explicit

 

'+-- Contstants'

Const CLASSNAME = "SyncContacts"

Const CLASSVERS = "1.0"

 

'+-- Class Variables'

Private olkSource As Outlook.Folder

Private olkTarget As Outlook.Folder

Private olkLog As Outlook.PostItem

Private strCategory As String

 

Public Property Let Category(strValue As String)

    strCategory = strValue

End Property

 

Public Property Set Source(olkFolder As Outlook.Folder)

    Set olkSource = olkFolder

End Property

 

Public Property Set Target(olkFolder As Outlook.Folder)

    Set olkTarget = olkFolder

End Property

 

Public Sub Sync()

    Dim olkItem As Object, _

        olkMatch As Outlook.ContactItem, _

        olkProp As Outlook.ItemProperty, _

        lngAdded As Long, _

        lngSynced As Long, _

        lngDeleted As Long, _

        lngIndex As Long, _

        datStart As Date

    datStart = Now

    lngAdded = 0

    lngDeleted = 0

    lngSynced = 0

    Set olkLog = Outlook.Application.CreateItem(olPostItem)

    olkLog.Subject = "Synchronization Run - " & Now

    olkLog.Body = ""

    olkLog.Display

    On Error Resume Next

    For Each olkItem In olkSource.Items

        If olkItem.Class = olContact Then

            If InStr(1, olkItem.Categories, strCategory) Then

                Set olkMatch = olkTarget.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

                If TypeName(olkMatch) = "Nothing" Then

                    Set olkMatch = olkTarget.Items.Add()

                    On Error Resume Next

                    For Each olkProp In olkItem.ItemProperties

                        If olkProp.Type <> olOutlookInternal Then

                            olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value

                        End If

                    Next

                    On Error GoTo 0

                    olkMatch.Save

                    lngAdded = lngAdded + 1

                    WriteToLog olkItem.FullName & " (Added)"

                Else

                    For Each olkProp In olkItem.ItemProperties

                        If olkProp.Type <> olOutlookInternal Then

                            olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value

                        End If

                    Next

                    olkMatch.Save

                    lngSynced = lngSynced + 1

                    WriteToLog olkItem.FullName & " (Synced)"

                End If

                Set olkMatch = Nothing

            End If

        End If

    Next

    For lngIndex = olkTarget.Items.count To 1 Step -1

        Set olkItem = olkTarget.Items.Item(lngIndex)

        Set olkMatch = olkSource.Items.Find("[FileAs] = '" & Replace(olkItem.FileAs, "'", "''") & "'")

        If TypeName(olkMatch) = "Nothing" Then

            olkItem.Delete

            lngDeleted = lngDeleted + 1

            WriteToLog olkItem.FullName & " (Deleted)"

        End If

        Set olkMatch = Nothing

    Next

    On Error Goto 0

    WriteToLog "Added: " & lngAdded

    WriteToLog "Synced: " & lngSynced

    WriteToLog "Deleted: " & lngDeleted

    WriteToLog "Elpased Time: " & DateDiff("S", datStart, Now) & " second(s)"

    olkLog.Display

End Sub

 

Private Sub WriteToLog(strEntry As String)

    olkLog.Body = olkLog.Body & "[" & Now & "]" & vbTab & strEntry

End Sub

Open in new window

0
 

Author Comment

by:robham
ID: 25784052
OK I think progess!

Before I ran the Sync I had 373 contacts in my local contacts folder, 3 of them had been copied in manually from BCM. The Sync ran fine, really quickly without any errors at all, and the end result produced:

[10/11/2009 10:29:02]   Gary Wilcox (Synced)
[10/11/2009 10:29:03]   Ian Donald (Synced)
[10/11/2009 10:29:04]   Kevin Davis (Synced)
[10/11/2009 10:29:20]   Added: 0
[10/11/2009 10:29:20]   Synced: 3
[10/11/2009 10:29:20]   Deleted: 368
[10/11/2009 10:29:20]   Elpased Time: 20 second(s)


You can see the top three were already there (these are the ones I copied manually from BCM) - they stayed in the local contacts folder and it deleted all my other contacts. Not a problem as I had all of them backed up obviously.

Out of interest I then added a zero to the end of Gary's home telephone number in BCM and ran the sync again, interestingly it did not change the telephone number in local contacts, and also reported again that it had deleted 386 contacts.

Certainly progress, but I think there are just two problems left. One is that it deletes all other contacts from the folder, and second if you change a contact in BCM it does not appear to copy the change down to local contacts next sync.

Thanks again for persisting with this.

Best regards

Rob


0
 
LVL 76

Expert Comment

by:David Lee
ID: 25791459
Rob,

I'm going to be out for about 10 days.  I'll work on this as soon as I get back.

Cheers!

David
0
 

Author Comment

by:robham
ID: 25920238
Thanks David,

I do apprecaite the continued effort you are making on this.

Rob
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 25926048
Hey, Rob.

"One is that it deletes all other contacts from the folder"
That's to be expected.  A proper sync includes deleting items that no longer exist in the source.  If an item exists in the local contacts but does not exist in the BCM contacts folder, then the code assumes that the item was deleted from BCM.  There's no way for it to know that the item never existed in BCM contacts.

"second if you change a contact in BCM it does not appear to copy the change down to local contacts next sync."
I don't doubt what's happening, but cannot understand how it's possible.  The code

                        If olkProp.Type <> olOutlookInternal Then
                            olkMatch.ItemProperties.Item(olkProp.Name) = olkProp.Value
                        End If

flatly copies every property of the item.  Clearly the code copies the properties the first time so it is unreasonable that it should then fail to copy it on every subsequent run.  Every version of the code that I've posted works perfectly at my end.  The difference is that I do not have BCM.  Even though BCM folders appear like Outlook folders the underlying mechanism must be so different that nothing is going to work.  It's beyond my understanding to see how the same code can copy a value on one pass and not copy it on another.  That defies all logic.  
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
Scam emails are a huge burden for many businesses. Spotting one is not always easy. Follow our tips to identify if an email you receive is a scam.
In this video we show how to create a Distribution Group in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Recipients >>…
In this Micro Video tutorial you will learn the basics about Database Availability Groups and How to configure one using a live Exchange Server Environment. The video tutorial explains the basics of the Exchange server Database Availability grou…

743 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

12 Experts available now in Live!

Get 1:1 Help Now