Solved

Business Contact Manager Sync to local contacts folder.

Posted on 2009-07-07
33
1,019 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
What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

 

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
 
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

Problems using Powershell and Active Directory?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

Question has a verified solution.

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

What does UTC stand for?  “Coordinated Universal Time” – Think of this as the true time on Planet Earth that never changes with the exception of minor leap seconds here and there to account for the changes in the planet's rotation.   What does th…
MS Outlook is a world-class email client application that is mainly used for e-communication globally.  In this article, we will discuss the basic idea about MS Outlook, its advanced features, and types of MS Outlook File formats.
The basic steps you have just learned will be implemented in this video. The basic steps are shown to configure an Exchange DAG in a live working Exchange Server Environment and manage the same (Exchange Server 2010 Software is used in a Windows Ser…
This video shows how to quickly and easily add an email signature for all users on Exchange 2016. The resulting signature is applied on a server level by Exchange Online. The email signature template has been downloaded from: www.mail-signatures…

810 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