If you store a contact in several Contacts folder, when you change the contact in one folder, you must hope that Outlook can auto update the same contacts in the other folders. Now, this article will assist you to auto sync the same contact in all folders.
Perhaps you have two or more different Contacts folders in your Outlook. In this case, if there are some contacts which are appearing in several folders, when you change a contact in one folder, you may long for a solution that could auto sync the same contact in all folders. Although Outlook doesn’t provide such a feature, you still can realize it with VBA code shown in the followings.
Auto Sync the Same Contact in All Folders
- In the first place, launch your Outlook application.
- Then, in the Outlook main window, you need to press “Alt + F11” key buttons.
- Next, you will get into the VBA editor window in success.
- In this window, you ought to access the “ThisOutlookSession” project.
- Subsequently, copy the VBA code below into this project.
Public WithEvents objInspectors As Inspectors Public WithEvents objContact As ContactItem Public objContactFolderPath As String Public strContactName As String Private Sub Application_Startup() Set objInspectors = Outlook.Application.Inspectors End Sub Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector) If Inspector.CurrentItem.Class = olContact Then Set objContact = Inspector.CurrentItem objContactFolderPath = objContact.parent.FolderPath strContactName = objContact.FullName End If End Sub Private Sub objContact_Write(Cancel As Boolean) Call SyncSameContactsInAllFolders(objContact) End Sub Sub SyncSameContactsInAllFolders(ByVal objSourceContact As ContactItem) Dim objStores As Stores Dim objStore As store On Error Resume Next Set objStores = Outlook.Application.Session.Stores For Each objStore In objStores Call ProcessFolders(objStore.GetRootFolder.Folders, objSourceContact) Next End Sub Sub ProcessFolders(ByVal objFolders As Folders, objSourceContact As ContactItem) Dim objFolder As Folder Dim objSameContact As ContactItem Dim objCopiedContact As ContactItem For Each objFolder In objFolders If objFolder.DefaultItemType = olContactItem Then If objFolder.FolderPath <> objContactFolderPath Then 'Find the same contacts in other folders Set objSameContact = objFolder.Items.Find("[FullName] = '" & strContactName & "'") If Not (objSameContact Is Nothing) Then Set objCopiedContact = objSourceContact.Copy objCopiedContact.Move objFolder objSameContact.Delete End If End If Call ProcessFolders(objFolder.Folders, objSourceContact) End If Next End Sub
- After that, sign this code.
- Later close the VBA editor window and proceed to alter your Outlook macro settings to enable signed macros.
- Finally you ought to restart your Outlook application, which will activate this new VBA project.
- From now on, every time when you modify a contact and save it, Outlook will auto find out the same contacts in other folders and update them.
Restore Data after Outlook Corruption
It’s almost an unquestioned fact that Outlook is prone to error and corruption. So, for regular users, it is vitally necessary to keep well-prepared for various Outlook troubles. For instance, you’d better develop a good habit of making regular data backups for your Outlook file. Plus, it is recommended to keep an Outlook repair utility nearby, like DataNumen Outlook Repair. It will come in handy when you’re trapped by Outlook crash.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including recover mdf and outlook repair software products. For more information visit www.datanumen.com