Сохранение Входящей Почты Локально

Тема в разделе "Lotus - Программирование", создана пользователем jonson88, 16 дек 2014.

  1. jonson88

    jonson88 New Member

    Регистрация:
    16 дек 2014
    Сообщения:
    1
    Симпатии:
    0
    День добрый форумчанам!
    Есть такая задача, сохранять текст всех входящих сообщений с Лотуса в виде текстового файла по указанному пути.
    Как я понимаю это проще всего реализовать созданием агента. Нигде не могу найти описание синтаксиса и правила обращения к объектам, даже сами названия объектов.

    Содавал на VBA автоматическую рассылку писем через лотус, даже сохранял вложенный файл по пути, но из какого то случайного одного письма.

    Может кто нибудь сталкивался с подобной задачей и может помочь в ее реализации, хотябы намек или ссылка на источник нужной информации.
     
  2. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.082
    Симпатии:
    300
  3. Ruslan280

    Ruslan280 Well-Known Member

    Регистрация:
    18 апр 2013
    Сообщения:
    49
    Симпатии:
    0
    делал когда еще лотусом не занимался вообще, поэтому .. стыдно самому) .
    но главное работает.
    создай агент в почтовом файле. включай расписание. будет работать на сервере и складывать почту куда надо. имя папки=дата\тема письма
    внутри папки файл с текстом письма и вложения.
    обработанные письма помечает знаком "~" в конце темы

    Код (LotusScript):
    Option Public

    Dim db As NotesDatabase
    Dim dc As NotesDocumentCollection
    Dim rtitem As Variant
    Dim titem As Variant
    Dim attachname As String
    Dim filename As String
    Dim body As NotesRichTextItem
    Dim emphasize As NotesRichTextStyle
    Dim tem As Variant
    Dim baza$(500)
    Dim fname$(500)
    Dim dsst
    Dim pokaz
    Dim pdate As NotesItem


    'Dim doc As NotesDocument
    Sub Initialize

    Dim session As New NotesSession
    Set db = session.CurrentDatabase
    Set dc = db.UnprocessedDocuments
    Set doc = dc.GetFirstDocument
    Set stream = session.CreateStream
    While Not(doc Is Nothing)

    Set rtitem = doc.GetFirstItem( "Body" )
    If Not rtitem Is Nothing Then
    If ( rtitem.Type = RICHTEXT ) Then
    If Not Isempty(rtitem) Then


    Set tem=doc.GetFirstItem( "Subject" )
    If Right$(tem.text,2)<>" ~" Then

    Set pdate = doc.GetFirstItem( "deliveredDate" )
    If Not ( pdate Is Nothing ) Then


    tema=tem.text

    subja = Trim(Mid$(tem.text, 1, 40))



    subj = ""
    For cd = 1 To Len(subja)
    sim = Mid$(subja, cd, 1)
    'вместо закарючек ставим пробелы
    qw = 0
    If sim = "\" Then qw = 1
    If sim = "/" Then qw = 1
    If sim = ":" Then qw = 1
    If sim = "*" Then qw = 1
    If sim = "?" Then qw = 1
    If sim = "<" Then qw = 1
    If sim = ">" Then qw = 1
    If sim = "|" Then qw = 1
    If sim = Chr(34) Then qw = 1
    If qw = 1 Then subj = subj & "_" Else subj = subj & sim
    Next cd
    'Msgbox subj
    curdat = Format(Date, "YYYYMMDD")
    desten="d:\#rusmail\"
    szdata desten & curdat 'создание папки с датой
    sztema desten & curdat & "\", subj 'сздание папки с темой
    'Msgbox     dsst & "\"  & attachname

    a=stream.Open(dsst & "\_konvert.txt")
    b=stream.WriteText(tema & Chr(13) & Chr(10) & Chr(13) & Chr(10))
    b=stream.WriteText(doc.GetItemValue("Body")(0), EOL_CRLF)
    Call stream.Close

    If Not Isempty(rtitem.EmbeddedObjects) Then

    Forall obj In rtitem.EmbeddedObjects
    If ( obj.Type = EMBED_ATTACHMENT ) Then
    '   Set emphasize = session.CreateRichTextStyle
    'emphasize.Bold = True
    'emphasize.NotesColor = COLOR_RED
    'Set body = doc.GetFirstItem("Body")
    'Call rtitem.AddNewLine( 2 )
    'Call body.AppendStyle(emphasize)        
    attachname = obj.source
    Call obj.ExtractFile( dsst & "\"  & attachname )

    'Call rtitem.AddNewLine( 2 )
    'Call rtitem.AppendText(( "Your file was downloaded to\\QDSWJDE1AMstarUnProcessed as filename: " ) & attachname)
    'Call doc.Save( False, True )

    End If
    End Forall
    End If

    Call doc.replaceItemValue("Subject",tem.text & " ~" )
    Call doc.Save( False, True )   

    Else
    Set pdate=Nothing
    End If

    End If
    End If
    End If
    End If
    Call session.UpdateProcessedDoc( doc )
    Set doc = dc.GetNextDocument (doc)

    Wend
    End Sub


    Sub szdata(puti)
    Doevents
    On Error Goto er
    Mkdir puti
    Exit Sub
    er:
    If Err = 75 Then Resume Next
    End Sub
    Sub sztema(puti, ppp)
    On Error Goto er
    Mkdir puti & Trim(ppp)
    dsst = puti & Trim(ppp)
    If era = 0 Then Exit Sub

    For n = 1 To 1000
    Doevents
    If direxist(puti & Trim(ppp) & Trim(n)) = False Then
    dsst = puti & Trim(ppp) & Trim(Str(n))

    eraa = 11
    Exit For
    End If
    Next n
    'если спецсимволы
    If eraa <> 11 Then
    For n = 50 To 1500
    Doevents
    If direxist(puti & Trim(Str(n))) = False Then
    dsst = puti & Trim(Str(n))

    Exit For
    End If
    Next n

    End If
    Exit Sub
    er:
    era = 1
    Resume Next
    End Sub
    Function direxist(papka)
    Doevents
    On Error Goto er
    direxist = False
    result = False
    Mkdir papka
    Exit Function
    er:
    If Err = 75 Or Err = 76 Then
    result = True
    direxist = True
    Resume Next
    End If
    End Function
     
Загрузка...

Поделиться этой страницей