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

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 Nothyng
Set pdc = pview.GetAllDocumentsByKey(doc.MainProcessID(0))
Set pdoc = pdc.GetFirstDocument
Do Until pdoc Is Nothyng
 
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 Nothyng Then Set bodyRT = memo.CreateRichTextItem("Body")
If fdc.Count > 0 Then
Set docFile = fdc.GetFirstDocument()
While Not docFile Is Nothyng
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 Nothyng     Цикл по ВИЗАМ в обзоре
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