1. Уважаемые участники и гости, 19 октября codeby будет работать в режиме "Только чтение". Регистрация новых участников будет закрыта. 20 октября портал продолжит работу в прежнем режиме.

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

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

  1. jonson88

    jonson88 New Member

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

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

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

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

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

    Ruslan280 Well-Known Member

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

    Код:
    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
     
Загрузка...

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