Imports System Imports System.ComponentModel Imports DevExpress.Xpo Imports DevExpress.Data.Filtering Imports DevExpress.ExpressApp Imports DevExpress.Persistent.Base Imports DevExpress.Persistent.BaseImpl Imports DevExpress.Persistent.Validation Imports DevExpress.ExpressApp.ConditionalAppearance Imports Microsoft.Office.Interop.Outlook Imports Microsoft.Office.Interop Public Enum eOverWriteDataType OverWriteOutlookData = 1 OverWriteNuvolarData = 2 End Enum Public Enum eSyscType eNormalSysnc = 1 eFirstSync = 2 End Enum ' _ _ _ _ _ _ _ _ Public Class Contacts_SysncOutlook Inherits BaseObject Private _OverWriteDataType As eOverWriteDataType Private _SyscType As eSyscType Private _Contacts_OutlookFolderContact As Contacts_OutlookFolderContact Private _IsFromOutlook As Boolean Public Sub New(ByVal session As Session) MyBase.New(session) End Sub Public Overrides Sub AfterConstruction() MyBase.AfterConstruction() OverWriteDataType = eOverWriteDataType.OverWriteOutlookData SyscType = eSyscType.eNormalSysnc IsFromOutlook = False End Sub Property OverWriteDataType As eOverWriteDataType Get Return _OverWriteDataType End Get Set(value As eOverWriteDataType) SetPropertyValue("OverWriteDataType", _OverWriteDataType, value) End Set End Property _ Property SyscType As eSyscType Get Return _SyscType End Get Set(value As eSyscType) SetPropertyValue("SyscType", _SyscType, value) End Set End Property Property Contacts_OutlookFolderContact As Contacts_OutlookFolderContact Get Return _Contacts_OutlookFolderContact End Get Set(ByVal value As Contacts_OutlookFolderContact) SetPropertyValue("OutlookContactsFolder", _Contacts_OutlookFolderContact, value) End Set End Property Property IsFromOutlook As Boolean Get Return _IsFromOutlook End Get Set(value As Boolean) SetPropertyValue("IsFromOutlook", _IsFromOutlook, value) End Set End Property '------------ReadOnly--------------------- Private ReadOnly Property Contacts_OutlookFolderContactCollection As XPCollection(Of Contacts_OutlookFolderContact) Get Dim _Contacts_DeleteFolderContacts As New XPCollection(Of Contacts_OutlookFolderContact)(Session) Session.Delete(_Contacts_DeleteFolderContacts) Dim _Contacts_OutlookFolderContact As New XPCollection(Of Contacts_OutlookFolderContact)(Session) Dim _OutlookApp As New Outlook.Application() Dim _OutlookNameSpace As Outlook.NameSpace = _OutlookApp.GetNamespace("MAPI") _OutlookNameSpace.Logon(, , False, True) Dim _ContactFolder As MAPIFolder = _OutlookApp.ActiveExplorer.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts) 'Dim _FolderSuggestedContacts As MAPIFolder = _OutlookApp.ActiveExplorer.Session.GetDefaultFolder(OlDefaultFolders.olFolderSuggestedContacts) If _ContactFolder IsNot Nothing Then Dim _DefMap As New Contacts_OutlookFolderContact(Session) _DefMap.EntryID = _ContactFolder.EntryID _DefMap.FolderName = _ContactFolder.Name _Contacts_OutlookFolderContact.Add(_DefMap) For Each _FoldersName As MAPIFolder In _ContactFolder.Folders OutlookFolderNames(_FoldersName, _Contacts_OutlookFolderContact) Next End If 'If _FolderSuggestedContacts IsNot Nothing Then ' Dim _DefMapSuggested As New Contacts_OutlookFolderContact(Session) ' _DefMapSuggested.EntryID = _FolderSuggestedContacts.EntryID ' _DefMapSuggested.FolderName = _FolderSuggestedContacts.Name ' _Contacts_OutlookFolderContact.Add(_DefMapSuggested) ' For Each _FolderSuggested As MAPIFolder In _FolderSuggestedContacts.Folders ' OutlookFolderSuggestedNames(_FolderSuggested, _Contacts_OutlookFolderContact) ' Next 'End If Return _Contacts_OutlookFolderContact End Get End Property '--------------Sub----------------------- Private Sub OutlookFolderNames(_FoldersName As MAPIFolder, Contacts_OutlookFolderContact As DevExpress.Xpo.XPCollection(Of [Module].Contacts_OutlookFolderContact)) If _FoldersName.Folders.Count > 0 Then Dim _Contacts_OutlookFolderContact As New Contacts_OutlookFolderContact(Session) _Contacts_OutlookFolderContact.EntryID = _FoldersName.EntryID _Contacts_OutlookFolderContact.FolderName = _FoldersName.Name Contacts_OutlookFolderContact.Add(_Contacts_OutlookFolderContact) For Each _FoldersNameAct As MAPIFolder In _FoldersName.Folders OutlookFolderNames(_FoldersNameAct, Contacts_OutlookFolderContact) Next Else Dim _Contacts_OutlookFolderContact As New Contacts_OutlookFolderContact(Session) _Contacts_OutlookFolderContact.EntryID = _FoldersName.EntryID _Contacts_OutlookFolderContact.FolderName = _FoldersName.Name Contacts_OutlookFolderContact.Add(_Contacts_OutlookFolderContact) End If End Sub Private Sub OutlookFolderSuggestedNames(_FolderSuggested As MAPIFolder, Contacts_OutlookFolderContact As DevExpress.Xpo.XPCollection(Of [Module].Contacts_OutlookFolderContact)) If _FolderSuggested.Folders.Count > 0 Then Dim _Contacts_OutlookFolderContact As New Contacts_OutlookFolderContact(Session) _Contacts_OutlookFolderContact.EntryID = _FolderSuggested.EntryID _Contacts_OutlookFolderContact.FolderName = _FolderSuggested.Name Contacts_OutlookFolderContact.Add(_Contacts_OutlookFolderContact) For Each _FoldersSuggestedNameAct As MAPIFolder In _FolderSuggested.Folders OutlookFolderSuggestedNames(_FoldersSuggestedNameAct, Contacts_OutlookFolderContact) Next Else Dim _Contacts_OutlookFolderContact As New Contacts_OutlookFolderContact(Session) _Contacts_OutlookFolderContact.EntryID = _FolderSuggested.EntryID _Contacts_OutlookFolderContact.FolderName = _FolderSuggested.Name Contacts_OutlookFolderContact.Add(_Contacts_OutlookFolderContact) End If End Sub End Class