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

jonson88

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

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

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

Ruslan280

Well-known member
18.04.2013
50
0
#3
делал когда еще лотусом не занимался вообще, поэтому .. стыдно самому) .
но главное работает.
создай агент в почтовом файле. включай расписание. будет работать на сервере и складывать почту куда надо. имя папки=дата\тема письма
внутри папки файл с текстом письма и вложения.
обработанные письма помечает знаком "~" в конце темы

Код:
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