LotusScript操纵附件

LotusScript操纵附件

Sub InitAttachment
 On Error Goto ErrorHandle
 Dim temDoc    As notesDocument
 Dim temDoc1  As NotesDocument
 Dim docAttachment As NotesDocument
 Dim strQuery   As String
 Dim strUNID   As String
 Dim strFormula  As String
 Dim strList  As String
 Dim vPath   As Variant
 strQuery = note.Query_String_Decoded(0)
 If Instr(strQuery,"&UNID=") > 0 Then
  strUNID = Mid(strQuery,Cint(Instr(strQuery,"&UNID=")) + 6,32)
  Set temDoc = db.GetDocumentByUNID(strUNID)
  If Not (temDoc Is Nothing) Then
   Set docAttachment = db.CreateDocument
   docAttachment.Form = "fmAttachment"
   docAttachment.Status = "0"
   docAttachment.CourseInfoUnid = temDoc.UniversalID
   If temDoc.HasEmbedded Then   
    Set temDoc1 = db.CreateDocument
    Call temDoc.CopyAllItems (temDoc1)
    Forall item In temDoc1.Items
     If Not (Ucase(item.Name) = "$FILE") Then
      temDoc1.RemoveItem (item.Name)
     End If
    End Forall
    Call temDoc1.CopyAllItems(docAttachment)
   End If   
  End If  
 End If
 Call docAttachment.Save(True,False)
 docAttachment.CurUnid = docAttachment.UniversalID
 Call docAttachment.Save(True,False)
 vPath = Evaluate(|@ReplaceSubstring(@Subset(@DbName;-1); " " : "\\"; "+" : "/")|)
 Print |<script language="javascript">  |
 Print |<!--       |
 Print |window.location.href = "/| & vPath(0) & _
 |/0/| & docAttachment.UniversalID & |?editdocument";|
 Print |-->    |
 Print |</script>   | 
 Exit Sub
'Domino Control Platform Error Info  
ErrorHandle:
 Messagebox db.FilePath & "_LibEduCommand.InitAttachment：" & Error$ & " at line number " & Cstr(Erl)
 'Resume Next 
End Sub