Открытие вложения в Richtext

  • Автор темы Maratik
  • Дата начала
M

Maratik

Гость
#1
Помогите пожалуйста с открытием вложения в RichText. Пробую - не получается. Мне нужно, чтобы по нажатию кнопочки определенное вложение в поле открывалось причем без диалога типа - Open|Preview|Edit... Если бы у кого-нибудь было что-то, напишите пожалуйста.
 
S

Sandr

Гость
#2
Код:
Function OpenAttach(file As NotesDocument)

On Error Goto errorProc


Dim fileItem As Notesrichtextitem
Dim appl As Variant
Dim filename As String
Dim o As NotesEmbeddedObject
Dim fileType As String
Dim taskID As Variant



If file.HasEmbedded Then
Set o = file.GetAttachment(file.GetItemValue("AttachName")(0))
If Not o Is Nothing Then

On Error Resume Next
filename = Environ$("Temp") & "\" & o.Source	 
On Error Goto errorProc

Else
Msgbox "Невозможно открыть вложение.", 48, "Ошибка"
Exit Function
End If


file.EmbedFilepath = filename


' активируем связанное с аттачем (или выбранное пользователем) приложение для просмотра вложения
fileType = Lcase(Strrightback(filename, "."))
Select Case fileType
Case "doc","rtf","dot": 'если документ ворда
Call o.ExtractFile (filename)
Set appl = CreateObject("Word.Application")
appl.visible = True
appl.Documents.Open filename
Case "xls","xlt": 'Если эксель
Call o.ExtractFile (filename)
Set appl = CreateObject("Excel.Application")
appl.visible = True
appl.Workbooks.add(filename)
Case "html","htm", "xml", "txt", "zip", "rar", "gif", "jpg", "jpeg", "bmp": 'Если это точно можно открыть эксплоером
Call o.ExtractFile (filename)
taskID = Shell("explorer.exe " & filename, 1)						 
Case Else: 'если что-то другое
Dim path As Variant
Dim dr As String
Dim stream As NotesStream
On Error Resume Next
dr = Environ$("HOMEPATH")
On Error Goto errorProc
If Err > 0 Then
Err = 0
dr = ""
End If
path = ws.SaveFileDialog(False,,,dr, o.Source)

If Not Isempty(path) Then
On Error Goto extracting
Open Path(0) For Input As 1
Close 1
If Msgbox ("Заменить сщуствующий " & o.Name & "?", 4 + 32 ,db.Title) = 6 Then
Call o.ExtractFile(Path(0))			  
End If
End If		 

End Select	 


End If

Exit Function

extracting:
Call o.ExtractFile(Path(0))
Resume endofsub

endofsub:	 
Exit Function
errorProc:	 
Msgbox "Error#" & Err & " on line " & Erl & " in function " & Lsi_info(2) & " : " & Error, 48, "Runtime error"
Resume endofsub

End Function
Нужный кусок, думаю, выковыяешь...