Dim s As New NotesSession
Dim db As NotesDatabase
Dim mime As NotesMIMEEntity
Dim memo As NotesDocument
Set db=s.CurrentDatabase
Set memo = db.CreateDocument
Set result = memo.CreateMIMEEntity("Body")
Dim hdr As NotesMIMEHeader
Set hdr = result.CreateHeader("MIME-Version")
Call hdr.SetHeaderValAndParams(|1.0|)
Set mime = result.CreateChildEntity( )
Dim stream As NotesStream
Set stream = s.CreateStream
s.ConvertMIME = False ' Restore conversion
stream.WriteText {<body>Тут пишем html-текст</body>}
mime.SetContentFromText stream, "text/html; charset=Windows-1251", ENC_IDENTITY_8BIT
'приаттачивание файлов
Set rtdoc=doc.GetFirstItem("Files")
If ( rtdoc.Type = RICHTEXT ) Then
If Not Isempty(rtdoc.EmbeddedObjects) Then
Set mime = result.CreateChildEntity( )
Forall object In rtdoc.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT ) Then
filepath =Environ("Temp")+"\"+Cstr(Object.Name)
Call object.ExtractFile(filepath)
tmpSource=Object.Source
i=i+1
NameSource:
If i=0 Then
Redim Preserve filenames(0)
filenames(0)=Object.Source
Else
For j=0 To Ubound(filenames)
If filenames(j)=tmpSource Then
tmpSource=Strleft(Object.Source,".")+Cstr(n)+"."+Strright(Object.Source,".")
n=n+1
Goto NameSource
End If
Next
'tmpSource=Strleft(Object.Source,".")+"_"+Cstr(n-1)+"."+Strright(Object.Source,".")
Redim Preserve filenames(Ubound(filenames)+1)
filenames(Ubound(filenames))=tmpSource
End If
tmp=Evaluate({@ReplaceSubstring(@URLEncode("UTF-8";"}+Cstr(tmpSource)+{");"%";"=")})
filename="=?utf-8?Q?"+tmp(0)+"?="
Set mime = result.CreateChildEntity( )
Set hdr = mime.CreateHeader("Content-Disposition")
Call hdr.SetHeaderValAndParams(|attachment; filename="|+filename+|"|)
Set hdr = mime.createHeader("Content-ID")
Call hdr.setHeaderVal(filename)
Set stream = s.CreateStream
stream.Open filepath, "binary"
mime.SetContentFromBytes stream, |application/octet-stream; name="|+filename+|"|, ENC_BINARY
mime.EncodeContent ENC_BASE64
Kill filepath
End If
End Forall
End If
End If
Call memo.CloseMIMEEntities(True, "Body")
memo.SendTo ="Кому "
memo.Principal="От кого"
memo.INetFrom="От кого"
memo.Subject = "Тема"
Call memo.Send(False)
s.ConvertMIME = True ' Restore conversion
Ссылка на оригинал
Dim db As NotesDatabase
Dim mime As NotesMIMEEntity
Dim memo As NotesDocument
Set db=s.CurrentDatabase
Set memo = db.CreateDocument
Set result = memo.CreateMIMEEntity("Body")
Dim hdr As NotesMIMEHeader
Set hdr = result.CreateHeader("MIME-Version")
Call hdr.SetHeaderValAndParams(|1.0|)
Set mime = result.CreateChildEntity( )
Dim stream As NotesStream
Set stream = s.CreateStream
s.ConvertMIME = False ' Restore conversion
stream.WriteText {<body>Тут пишем html-текст</body>}
mime.SetContentFromText stream, "text/html; charset=Windows-1251", ENC_IDENTITY_8BIT
'приаттачивание файлов
Set rtdoc=doc.GetFirstItem("Files")
If ( rtdoc.Type = RICHTEXT ) Then
If Not Isempty(rtdoc.EmbeddedObjects) Then
Set mime = result.CreateChildEntity( )
Forall object In rtdoc.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT ) Then
filepath =Environ("Temp")+"\"+Cstr(Object.Name)
Call object.ExtractFile(filepath)
tmpSource=Object.Source
i=i+1
NameSource:
If i=0 Then
Redim Preserve filenames(0)
filenames(0)=Object.Source
Else
For j=0 To Ubound(filenames)
If filenames(j)=tmpSource Then
tmpSource=Strleft(Object.Source,".")+Cstr(n)+"."+Strright(Object.Source,".")
n=n+1
Goto NameSource
End If
Next
'tmpSource=Strleft(Object.Source,".")+"_"+Cstr(n-1)+"."+Strright(Object.Source,".")
Redim Preserve filenames(Ubound(filenames)+1)
filenames(Ubound(filenames))=tmpSource
End If
tmp=Evaluate({@ReplaceSubstring(@URLEncode("UTF-8";"}+Cstr(tmpSource)+{");"%";"=")})
filename="=?utf-8?Q?"+tmp(0)+"?="
Set mime = result.CreateChildEntity( )
Set hdr = mime.CreateHeader("Content-Disposition")
Call hdr.SetHeaderValAndParams(|attachment; filename="|+filename+|"|)
Set hdr = mime.createHeader("Content-ID")
Call hdr.setHeaderVal(filename)
Set stream = s.CreateStream
stream.Open filepath, "binary"
mime.SetContentFromBytes stream, |application/octet-stream; name="|+filename+|"|, ENC_BINARY
mime.EncodeContent ENC_BASE64
Kill filepath
End If
End Forall
End If
End If
Call memo.CloseMIMEEntities(True, "Body")
memo.SendTo ="Кому "
memo.Principal="От кого"
memo.INetFrom="От кого"
memo.Subject = "Тема"
Call memo.Send(False)
s.ConvertMIME = True ' Restore conversion
Ссылка на оригинал
Комментариев нет:
Отправить комментарий