N
Nonlim
Итак, исходные... имеется Lotus 8.5, HP Service Desk (черт его знает, какой версии) и агент, посылающий заявки из Лотуса.
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Агент, формирующий и отсылающий письма</div></div><div class="sp-body"><div class="sp-content">
в итоге письмо-отчет отсылается, но при наличии в письме текста и вложений - в HPSD чаще всего приходят только вложения (без текста).
Как исправить (или хотя бы с чьей стороны проблема)?
Пробовал отсылку на Outlook - приходит и текст, и вложение (собссна, он и используется пока в качестве "костыля").
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Агент, формирующий и отсылающий письма</div></div><div class="sp-body"><div class="sp-content">
Код:
Option Public
Option Declare
Use "ADF_Engine"
Use "ADF_Transport"
Sub Initialize
On Error Goto ErrHandler
Dim s As New NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim pdc As NotesDocumentCollection
Dim fdc As NotesDocumentCollection
Dim view As NotesView
Dim fview As NotesView
Dim pview As NotesView
Dim doc As NotesDocument
Dim pdoc As NotesDocument
Dim memo As NotesDocument
Dim t As String
Dim DirName As String
Dim object As NotesEmbeddedObject
Dim dbFile As NotesDatabase
Dim docFile As NotesDocument
Dim bodyRT As NotesRichTextItem
Dim findfileName As String
Dim vc As NotesDocumentCollection
Dim visaView As NotesView
Dim visadoc As NotesDocument ' визы
Msgbox "============ Отсылка в HPSD|ToHPSD ==========="
Set db = s.CurrentDatabase
Set view = db.GetView("RequestForHPSD")
Set pview = db.GetView("ViewPersonById")
Set dc = view.GetAllDocumentsByKey("1")
If dc.Count = 0 Then
Exit Sub
End If
Set dbFile = New NotesDatabase(db.Server, "Referent\br_f_zayavki.nsf" )
DirName = "d:\Temp\"
Set fview = dbFile.GetView("FilesByAgrUNIDAdd")
Set visaView = db.getView("DBVisasComment")
fview.Refresh
Set doc = dc.GetFirstDocument
Msgbox "=" + Cstr(dc.Count)
Do Until doc Is Nothing
Set pdc = pview.GetAllDocumentsByKey(doc.MainProcessID(0))
Set pdoc = pdc.GetFirstDocument
Do Until pdoc Is Nothing
' Msgbox " >>> " + pdoc.Executor(0)
Set memo = New notesdocument(db)
memo.Subject = Cstr(doc.DocNumber(0)) + "-" + Cstr(pdoc.UniversalID)
Set fdc = fview.GetAllDocumentsByKey(doc.MainProcessID(0), True)
' прикладываем Сопутствующие
Set bodyRT = memo.GetFirstItem("Body")
If bodyRT Is Nothing Then Set bodyRT = memo.CreateRichTextItem("Body")
If fdc.Count > 0 Then
Set docFile = fdc.GetFirstDocument()
While Not docFile Is Nothing
findfileName = ExtractFileToDir(docFile, DirName)
Msgbox findfileName
If findfileName <> "" Then
Set object = bodyRT.EmbedObject(EMBED_ATTACHMENT, "", DirName & findfileName)
Kill DirName & findfileName
End If
Set docFile = fdc.GetNextDocument(docFile)
Wend
End If
'Ниже формируем текстовую составляющую письма
Call bodyRT.AddNewline(1)
bodyRT.AppendText("Сервис: " + doc.DocName(0) + ";")
Call bodyRT.AddNewline(1)
t = "Пользователь: " + pdoc.Executor(0)
If pdoc.ExecutorPost(0) <> "" Then
t = t + ", " + pdoc.ExecutorPost(0)
End If
If pdoc.ExecutorDep(0) <> "" Then
t = t + ", " + pdoc.ExecutorDep(0)
End If
bodyRT.AppendText(t + ";")
Call bodyRT.AddNewline(1)
If pdoc.ExecutorEmail(0) <> "" Then
bodyRT.AppendText("e-mail: " + pdoc.ExecutorEmail(0) + ";")
Call bodyRT.AddNewline(1)
End If
If pdoc.ExecutorPhone(0) <> "" Then
bodyRT.AppendText("Телефон: " + pdoc.ExecutorPhone(0) + ";")
Call bodyRT.AddNewline(1)
End If
If pdoc.PersonFunction(0) <> "" Then
bodyRT.AppendText("Функции в системе: " + pdoc.PersonFunction(0) + ";")
Call bodyRT.AddNewline(1)
End If
If pdoc.PersonObject(0) <> "" Then
bodyRT.AppendText("Объекты учета: " + pdoc.PersonObject(0))
If pdoc.Comment(0) <> "" Then
bodyRT.AppendText(" (" + pdoc.Comment(0) + ")")
End If
bodyRT.AppendText(";")
Call bodyRT.AddNewline(1)
End If
If pdoc.PersonType(0) <> "" Then
bodyRT.AppendText("Тип подключения: " + Replace(Replace(pdoc.PersonType(0), "1", "впервые"), "2", "дополнение функций") + ";")
Call bodyRT.AddNewline(1)
End If
If pdoc.PersonLogin(0) <> "" Then
bodyRT.AppendText("Логин: " + pdoc.PersonLogin(0) + ";")
Call bodyRT.AddNewline(1)
End If
If pdoc.DateEnd(0) <> "" Then
bodyRT.AppendText("Предоставляется до: " + pdoc.DateEnd(0) + ";")
Call bodyRT.AddNewline(1)
End If
If doc.HasItem("DocBodyDefault") And doc.DocBodyDefault <> "" Then
bodyRT.AppendText("Комментарий: " + doc.DocBodyDefault + ";")
Call bodyRT.AddNewline(1)
End If
' получение коллекции виз текущего документа
Set vc = visaView.GetAllDocumentsByKey(doc.MainProcessID, True)
Set visadoc = vc.GetFirstDocument
While Not visadoc Is Nothing ' Цикл по ВИЗАМ в обзоре
If visadoc.ISADD_REV(0) = "1" Then
bodyRT.AppendText("Доп. согласующий " + visadoc.REAL_REV_RUS(0) + ": " + visadoc.Comment(0) + ";")
Else
If visadoc.Comment(0) = "" Then
bodyRT.AppendText("Согласующий " + visadoc.REAL_REV_RUS(0) + "(" + visadoc.DECISION(0) + ");")
Else
bodyRT.AppendText("Согласующий " + visadoc.REAL_REV_RUS(0) + "(" + visadoc.DECISION(0) + "): " + visadoc.Comment(0) + ";")
End If
End If
Call bodyRT.AddNewline(1)
Set visadoc = vc.GetNextDocument(visadoc)
Wend
Call bodyRT.AddNewline(1)
' список получателей письма
' memo.ReplaceItemValue("SendTo", "Spam_PhoneMasters").IsAuthors = True
' memo.ReplaceItemValue("SendTo", "sed@email.ru").IsAuthors = True
Call memo.Send(False)
Msgbox " >>> " + pdoc.Executor(0) + " sended"
doc.ToHPSD = "2"
Set pdoc = pdc.GetNextDocument(pdoc)
Loop
If doc.ToHPSD(0) = "2" Then
Call doc.save(True, False)
End If
Set doc = dc.GetNextDocument(doc)
Loop
done:
Msgbox "--------------- Отсылка в HPSD|ToHPSD -----------------------"
Exit Sub
ErrHandler:
Msgbox "ERROR Agent Отсылка в HPSD|ToHPSD: " & Error$ & " в строке " & Erl
Resume done
End Sub
Как исправить (или хотя бы с чьей стороны проблема)?
Пробовал отсылку на Outlook - приходит и текст, и вложение (собссна, он и используется пока в качестве "костыля").