Sub Click(Source As Button)
On Error Goto errhand
Dim ws As New NotesUIWorkspace
Dim uidocST As NotesUIDocument
Dim docST As NotesDocument
Dim db As NotesDatabase
Dim s As New NotesSession
Dim unid As String
Dim Name1 As String
Dim fn As Variant
Set db = s.CurrentDatabase
Set uidocST=ws.CurrentDocument
Set docST = uidocST.Document
fn= ws.OpenFileDialog(False, "Выбрать файл", "GIF Image|*.gif", "c:\My Documents")
Forall FileName In fn
Name1 = FileName
End Forall
Call uidocST.GotoField("foto")
Call uidocST.Import("GIF Image", Name1)
unid = docST.universalID
Call uidocST.Save
uidocST.Document.ReplaceItemValue("SaveOptions", "0").savetodisk = False
Call uidocST.close
On Error Resume Next
Set docST = db.getdocumentByUNID(unid)
On Error Goto errhand
If Not docST Is Nothing Then
Dim RTItem As NotesRichTextItem
Set RTItem= New NotesRichTextItem(docST, "att" )
Call RTItem.EmbedObject(EMBED_ATTACHMENT , "", Name1) ' крепим аттачмент к темповому документу
Call docST.save(True, False)
Call ws.EditDocument(True, docST)
Else
Msgbox "Не смогли получить документ!"
End If
exiting:
Exit Sub
errhand:
Msgbox "Ошибка " & Error & ", в строке " & Cstr(Erl)
Resume exiting
End Sub
Set RTItem= New NotesRichTextItem(docST, "att" )
Set RTItem = docST.GetFirstItem("att")
If not RTItem is nothing then Call RTItem.Remove
Set RTItem= New NotesRichTextItem(docST, "att" )
On Error Goto errhand
Dim ws As New NotesUIWorkspace
Dim uidocST As NotesUIDocument
Dim docST As NotesDocument
Dim db As NotesDatabase
Dim s As New NotesSession
Dim unid As String
Dim Name1 As String
Dim fn As Variant
Set db = s.CurrentDatabase
Set uidocST=ws.CurrentDocument
Set docST = uidocST.Document
fn= ws.OpenFileDialog(False, "Выбрать файл", "GIF Image|*.gif", "c:\My Documents")
Forall FileName In fn
Name1 = FileName
End Forall
Dim RTItem As NotesRichTextItem
Call uidocST.GotoField("Foto")
Call uidocST.FieldClear("Foto" )
Call uidocST.Import("GIF Image", Name1)
unid = docST.universalID
Call uidocST.Save
uidocST.Document.ReplaceItemValue("SaveOptions", "0").savetodisk = False
Call uidocST.close
On Error Resume Next
Set docST = db.getdocumentByUNID(unid)
On Error Goto errhand
If Not docST Is Nothing Then
Set RTItem = docST.GetFirstItem("Att")
If Not RTItem Is Nothing Then Call RTItem.Remove
Set RTItem= New NotesRichTextItem(docST, "Att" )
Call RTItem.EmbedObject(EMBED_ATTACHMENT , "", Name1) ' крепим аттачмент к темповому документу
RTItem.Remove
Call docST.save(True, False)
Call ws.EditDocument(True, docST)
Else
Msgbox "Не смогли получить документ!"
End If
exiting:
Exit Sub
errhand:
Msgbox "Ошибка " & Error & ", в строке " & Cstr(Erl)
Resume exiting
Dim s As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim body As NotesMIMEEntity
Dim stream As NotesStream
Set db = s.CurrentDatabase
s.ConvertMIME = False ' Do not convert MIME to rich text
Set doc = db.CreateDocument
Call doc.ReplaceItemValue("Form", "Form_main")
Set body = doc.CreateMIMEEntity
Set header = body.CreateHeader("Foto")
Call header.SetHeaderVal("MIME image from GIF file")
Set stream = s.CreateStream
If Not stream.Open("e:\1\2.gif", _
"binary") Then
Messagebox "e:\1\2.gif",, _
"Open failed"
Goto ExitSub
End If
If stream.Bytes = 0 Then
Messagebox "e:\1\2.gif",, _
"File has no content"
Goto ExitSub
End If
Call body.SetContentFromBytes(stream, _
"image/gif", ENC_IDENTITY_BINARY)
Call stream.Close
Call doc.Save(True, True)
ExitSub:
s.ConvertMIME = True ' Restore conversion
Set doc = db.CreateDocument
Call doc.ReplaceItemValue("Form", "Form_main")
Set doc=ws.CurrentDocument.Document
Constantin A Chervonenko
не подскажешь как вставаить картинку как объект MIME, ничего подходящего немогу найти(
session.ConvertMime = False
Set mimeRoot = doc.CreateMIMEEntity(itemName)
Set multiStream = session.CreateStream()
multiStream.WriteText "This is a multipart message in MIME format."
multiStream.Position = 0
Call mimeRoot.SetContentFromText(multiStream,"multipart/related",ENC_NONE)
multiStream.Close
Set mime = mimeRoot.createChildEntity()
Set htmlStream = session.CreateStream()
htmlStream.writeText "<br><img src=cid:importedimage>"
htmlStream.Position = 0
Call mime.setContentFromText(htmlStream, "text/html;charset=""US-ASCII""", ENC_NONE)
htmlStream.close
Set mime = mimeRoot.createChildEntity()
Set header = mime.CreateHeader("Content-ID")
Call header.SetHeaderVal("<importedimage>")
Set header = mime.CreateHeader("Content-Transfer-Encoding")
Call header.setHeaderVal("Base64")
Call mime.setContentFromBytes(pictureStream, imType, ENC_IDENTITY_BINARY)
Call mime.encodeContent(ENC_BASE64)
On Error Goto errhand
1. Dim session As New NotesSession
2. Dim ws As New NotesUIWorkspace
3. Dim db As NotesDatabase
4 Dim docST As NotesDocument
5 Dim body As NotesMIMEEntity
6 Dim stream As NotesStream
7 Set db = session.CurrentDatabase
8 session.ConvertMIME = False ' Не конвертируем данные в полу...
9 Set docST = ws.CurrentDocument.Document
10 Call docST.ReplaceItemValue("Form", "Form_Izdel") 'задаём имя формы, непонятно зачем правда))
11 Set body = docST.CreateMIMEEntity 'создаём NotesMIMEEntuty d ljrevtynt
12 Set header = body.CreateHeader("Att") 'создаём поле....а как привязать к существующему?или надо как то иначе сделать? body.GetNthHeader("Att")
'Set header = body.GetNthHeader("Att") '
13 Call header.SetHeaderVal("MIME image from GIF file") 'устанавливаем ценность нашего поля
14 Set stream = session.CreateStream
15 If Not stream.Open("e:\1\2.gif","binary") Then
16 Messagebox "e:\1\2.gif",, "Open failed"
17 Goto ExitSub
18 End If
19 If stream.Bytes = 0 Then
20 Messagebox "e:\1\2.gif",, "File has no content"
21 Goto ExitSub
22 End If
23 Call body.SetContentFromBytes(stream,"image/gif", ENC_IDENTITY_BINARY) 'пишем данные в поле
24 Call stream.Close
25 Call docST.Save(True, True)
26 ExitSub:
27 session.ConvertMIME = True ' Устанавливаем преобразование...
28 exiting:
29 Exit Sub
30 errhand:
31 Msgbox "Ошибка " & Error & ", в строке " & Cstr(Erl)
32 Resume exiting
Sub Initialize
Dim ses As NotesSession
Dim curdb As NotesDatabase
Dim curdoc As NotesDocument
Dim dcol As NotesDocumentCollection
Dim tdoc As NotesDocument
Dim rti As NotesRichTextItem
Dim arr
Dim ss As String
'=
Set ses = New NotesSession
Set curdb=ses.CurrentDatabase
Set curdoc=ses.DocumentContext
Set dcol=curdb.Search({Select Form="News"}, Nothing, 0)
If dcol.Count<=0 Then
Call curdoc.ReplaceItemValue("Body", "No news found!")
Exit Sub
End If
'=
Set tdoc=dcol.GetFirstDocument
While Not(tdoc Is Nothing)
'=
Set rti=tdoc.GetFirstItem("Foto")
If Not(rti Is Nothing) Then
If rti.Type=RICHTEXT Then
arr=rti.EmbeddedObjects
If Not(Isempty(arr)) Then
Forall obj In arr
If Not(obj Is Nothing) Then
If obj.Type=EMBED_ATTACHMENT Then
ss=ss+{<img src="Как отобразить obj????"><br>}
End If
End If
End Forall
End If
End If
End If
'=
Set tdoc=dcol.GetNextDocument(tdoc)
Wend
Call curdoc.ReplaceItemValue("Body", ss)
End Sub
так это же работа с картинками которые были внедрены с помощью File-ImportВот ещё какой момент....
В этом примере вынимается объект как in-line....разьве Import не вставляет объект такого типа? там экпортируется документ в XML...и ищем теги <gif>, куски которые в тегах данного вида экспортируются. Как вставить так картинку чтобы при выгрузке в XML были теги gif?....импорт их недаёт....
1)есть одна форма "News"
там имеется рт поле "Foto", сюда приАТТАЧиваю изображение, сохраняю и закрываю документ(естественно все происходит в лотусе)
например какиеВсе методы для подобной задачи извратные...
Sandr
Другими не получается....всё время куда то утыкаюсь))) А поджимает уже...(
пост 73 посмотри плиз...)
Взломай свой первый сервер и прокачай скилл — Начни игру на HackerLab