Интерфейс TDMS и ms outlook

' Объектная модель класса nMessage
  'Public Sender As MyCorrespondent
    'Public Alias As String  
    'Email
  'Public Recipients As MyRecipients
    'Item
      'Public Alias As String  
      'Email
    'Count
  'Public Subject As String
  'Public Body As String
  'Public SendDate As Date
  'Public EntryID As String
  'Public Automatic As Boolean
  'Files
    'Item
      'Path
      'Name
    'Count
'_______________________________________________________________________
' Внешняя функция получающая на вход сообщение из Outlook
Function GetMessage(nMessage)
Extern GetMessage
  ' Проверяем уникальность сообщения
  If CheckEntryId(nMessage.EntryID) Then
    MsgBox "Уже в системе"
    If nMessage.Automatic = False Then Exit Function
  End If
  ' Поиск контакта отправителя, в ручном режиме контакт может быть создан
  Set tSender = GetContact(nMessage.Sender.Email)
  ' Если контакт есть, то создаём сообщение
  If Not tSender Is Nothing Then 
    CreateMessage tSender, nMessage
  ElseIf nMessage.Automatic = False Then
    Set tForm = ThisApplication.InputForms("FORM_CONTACT_CREATE")
    With tForm
    If .Show Then
      contType = .Attributes("ATTR_CONTACT_TYPE").Classifier.SysName
      If .Attributes("ATTR_CONTACT_ASSOCIATION") Then
        Set tSender = .Attributes("ATTR_EVENT_TO_CONTACT").Object
        Set tRow = tSender.Attributes("ATTR_CONTACT_EMAILS").Rows.Create
          tRow.Attributes("ATTR_EMAIL_ADDRESS") = nMessage.Sender.Email
          tRow.Attributes("ATTR_EMAIL_NICK") = nMessage.Sender.Alias
        CreateMessage tSender, nMessage
      Else
        Set tSender = ThisApplication.ExecuteScript("CMD_CONTACT_CREATE", "CreateContact", _
          .Attributes("ATTR_CONTACT_DEPARTMENT").Object, nMessage.Sender,contType)
        If Not tSender Is Nothing Then CreateMessage tSender, nMessage
      End If
    End If
    End With
  End If
  ' Удаление выгруженнх файлов
  On Error Resume Next
  Set FSO = CreateObject("Scripting.FileSystemObject")
  For i = 0 To nMessage.Files.Count - 1
    FSO.DeleteFile nMessage.Files.Item(i).Path, True
  Next
  On Error GoTo 0
End Function
'_______________________________________________________________________

'_______________________________________________________________________
' Проверяем уникальность сообщения
Function CheckEntryId(nEntryID)
  CheckEntryId = False
  Set QueryMessage = ThisApplication.CreateQuery
    QueryMessage.AddCondition 1, nEntryID, "ATTR_EVENT_EMAIL_ID"
    If QueryMessage.Objects.Count > 0 Then CheckEntryId = True
End Function
'_______________________________________________________________________

'_______________________________________________________________________
' Создание сообщения
Function CreateMessage(tSender, nMessage)
  Set tMessage = ThisApplication.ObjectDefs("OBJECT_EVENT_MAIL").CreateObject
  tMessage.Attributes("ATTR_EVENT_EMAIL_ID") = nMessage.EntryID
  tMessage.Attributes("ATTR_EVENT_DATE") = nMessage.SendDate
  tMessage.Attributes("ATTR_EVENT_SUBJECT") = nMessage.Subject
  tMessage.Attributes("ATTR_EVENT_DESCRIPTION") = nMessage.Body
  tMessage.Attributes("ATTR_EVENT_FROM").Object = tSender
  ' Создаём связи с контактами
  For i = 0 To nMessage.Recipients.Count - 1
    Set tRecipient = GetContact(nMessage.Recipients.Item(i).Email)
    If Not tRecipient Is Nothing Then
      Set nRow = tMessage.Attributes("ATTR_EVENT_TO").Rows.Create
        nRow.Attributes("ATTR_EVENT_TO_CONTACT").Object = tRecipient
    End If
  Next
  ' Загружаем файлы вложения
  For i = 0 To nMessage.Files.Count - 1
    Set tFile = tMessage.Files.Create("FILE_ANY")
    tFile.CheckIn nMessage.Files.Item(i).Path
  Next
  tMessage.Status = ThisApplication.Statuses("STATUS_EVENT_MAIL_RECIEVED")
  Set CreateMessage = tMessage
End Function
'_______________________________________________________________________

'_______________________________________________________________________
' Поиск контакта по электронному адресу
Function GetContact(tEmail)
Set GetContact = Nothing
  Set QueryContact = ThisApplication.Queries("QUERY_CONTACT_BY_EMAIL")
    QueryContact.Parameter("P_MAIL") = tEmail
    'QueryContact.AddCondition 1, tEmail, "ATTR_EMAIL_ADDRESS"
  If QueryContact.Objects.Count > 0 Then Set GetContact = QueryContact.Objects(0)
End Function
'_______________________________________________________________________