Проблема С Отправкой E-mail

Nonlim · 17.02.2013

Итак, исходные... имеется 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">

Код:

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

в итоге письмо-отчет отсылается, но при наличии в письме текста и вложений - в HPSD чаще всего приходят только вложения (без текста).
Как исправить (или хотя бы с чьей стороны проблема)?
Пробовал отсылку на Outlook - приходит и текст, и вложение (собссна, он и используется пока в качестве "костыля").

hosm · 18.02.2013

очень не нравится мне эта конструкция doc.DocBodyDefault <> "" - по идее, это рт-поле, и там надо проверять, например, getUnformattedText или хотя б doc.DocBodyDefault(0) - может, на этой строке вылетает Type mismatch - посмотрите лог сервера.

VladSh · 18.02.2013

Форум есть, теперь не нужно платить денег разработчикам. ЗдОрово!

garrick · 19.02.2013

Ха! И вас такая же фигня работает

У нас были проблемы с кодировками писем в HPSD, поэтому сразу сделали в Lotus Notes формирование письма через MIME, никаких проблем с аттачами обнаружено не было.

Все сервисы Codeby

Поиск

Поиск

Проблема С Отправкой E-mail

Nonlim

hosm

VladSh

начинающий

garrick