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

Тема в разделе "Lotus - Программирование", создана пользователем Maratik, 5 май 2008.

  1. Maratik

    Maratik Гость

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

    Sandr Гость

    Код (Text):
    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
    Нужный кусок, думаю, выковыяешь...
     
Загрузка...

Поделиться этой страницей