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 Microsoft.Office.Interop.Outlook Imports Microsoft.Office.Interop Imports System.IO Imports DevExpress.ExpressApp.ConditionalAppearance Public Enum eCRMEstate_Leads eCRM = 0 'Klasszikus CRM rendszerből eCRMEstate = 1 'Ingatlanértékesítési rendszerből eManual = 2 'Manuálisan felvitt End Enum _ _ _ _ _ Public Class OutlookEMail Inherits BaseObject Private _Recipients As String 'Kinek megy az emil Private _Subject As String 'Tárgy Private _HTMLBody As String 'HTML szöveg Private _EntryID As String = "" 'Outlook item ID Private _ObjectCreated As Date 'Mikor készült az objektum Private _UserCreated As User 'Ki készítette Private _OwnerUser As User Private _CRM_Leads As CRM_Leads 'Leads-hoz tartozik-e Private _CRM_Opportunities As CRM_Opportunities Private _CRMEstate_Leads As CRMEstate_Leads Private _eCRMEstate_Leads As eCRMEstate_Leads Private _OutlookEMailIn_Oid As String Public Sub New(ByVal session As Session) MyBase.New(session) End Sub Public Overrides Sub AfterConstruction() MyBase.AfterConstruction() Dim _CurrentUser As User = Session.GetObjectByKey(Of User)(Session.GetKeyValue(SecuritySystem.CurrentUser)) Me.ObjectCreated = GetSQLTime(Session) Me.UserCreated = _CurrentUser End Sub _ _ Property Recipients As String Get Return _Recipients End Get Set(value As String) SetPropertyValue("Recipients", _Recipients, value) End Set End Property _ _ Property Subject As String Get Return _Subject End Get Set(value As String) SetPropertyValue("Subject", _Subject, value) End Set End Property _ Property HTMLBody As String Get Return _HTMLBody End Get Set(value As String) SetPropertyValue("HTMLBody", _HTMLBody, value) End Set End Property _ Property EntryID As String Get Return _EntryID End Get Set(value As String) SetPropertyValue("EntryID", _EntryID, value) End Set End Property _ Property ObjectCreated As Date Get Return _ObjectCreated End Get Set(value As Date) SetPropertyValue("ObjectCreated", _ObjectCreated, value) End Set End Property _ Property UserCreated As User Get Return _UserCreated End Get Set(value As User) SetPropertyValue("UserCreated", _UserCreated, value) End Set End Property Public Property OwnerUser As User Get Return _OwnerUser End Get Set(value As User) SetPropertyValue("OwnerUser", _OwnerUser, value) End Set End Property Property CRM_Leads As CRM_Leads Get Return _CRM_Leads End Get Set(value As CRM_Leads) SetPropertyValue("CRM_Leads", _CRM_Leads, value) End Set End Property Public Property CRM_Opportunities As CRM_Opportunities Get Return _CRM_Opportunities End Get Set(value As CRM_Opportunities) SetPropertyValue("CRM_Opportunities", _CRM_Opportunities, value) End Set End Property Public Property CRMEstate_Leads As CRMEstate_Leads Get Return _CRMEstate_Leads End Get Set(value As CRMEstate_Leads) SetPropertyValue("CRMEstate_Leads", _CRMEstate_Leads, value) End Set End Property _ Public Property eCRMEstate_Leads As eCRMEstate_Leads Get Return _eCRMEstate_Leads End Get Set(value As eCRMEstate_Leads) SetPropertyValue("eCRMEstate_Leads", _eCRMEstate_Leads, value) End Set End Property _ _ _ Public Property OutlookEMailIn_Oid As String Get Return _OutlookEMailIn_Oid End Get Set(value As String) SetPropertyValue("OutlookEMailIn_Oid", _OutlookEMailIn_Oid, value) End Set End Property '--- ReadOnly ---------- _ _ ReadOnly Property OutlookEMailAttachments As XPCollection(Of OutlookEMailAttachments) Get Return GetCollection(Of OutlookEMailAttachments)("OutlookEMailAttachments") End Get End Property '--- Sub--------------- Public Sub SendMail(_OutlookEmail As OutlookEMail, _ObjectSpace As Xpo.XPObjectSpace, Optional _WithCommit As Boolean = False) Dim _OutlookApp As New Outlook.Application() Dim _OutlookNameSpace As Outlook.NameSpace Dim _FdMail As Outlook.MAPIFolder Dim _Mail_New As Outlook.MailItem = _OutlookApp.CreateItem(OlItemType.olMailItem) Dim _OutlookEMailAttachments As OutlookEMailAttachments Dim _FileStream As Stream Dim _FilePath As String _OutlookNameSpace = _OutlookApp.GetNamespace("MAPI") _OutlookNameSpace.Logon(, , True, True) _FdMail = _OutlookNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderOutbox) _Mail_New = _FdMail.Items.Add(Outlook.OlItemType.olMailItem) _Mail_New.Subject = _OutlookEmail.Subject _Mail_New.To = _OutlookEmail.Recipients _Mail_New.HTMLBody = _OutlookEmail.HTMLBody If _OutlookEmail.OutlookEMailAttachments.Count > 0 Then For Each _OutlookEMailAttachments In _OutlookEmail.OutlookEMailAttachments _FilePath = Path.GetTempPath & _OutlookEMailAttachments.DocumentFileData.File.FileName _FileStream = New FileStream(_FilePath, FileMode.Create) _OutlookEMailAttachments.DocumentFileData.File.SaveToStream(_FileStream) Dim _AttachFile As Outlook.Attachments = _Mail_New.Attachments Dim _Attach As Outlook.Attachment = _AttachFile.Add(_FilePath) _FileStream.Close() If System.IO.File.Exists(_FilePath) Then System.IO.File.Delete(_FilePath) End If Next End If _Mail_New.Save() _OutlookEmail.EntryID = _Mail_New.EntryID _Mail_New.UnRead = True _Mail_New.Send() If _WithCommit = True Then _OutlookEmail.Save() _ObjectSpace.CommitChanges() End If End Sub End Class