萍客小居

Sub Initialize    
         On Error Goto MsgError
         Dim session As New NotesSession
       Dim doc As NotesDocument
          Dim FilePath As String
          Dim fileNames As Variant
         Dim objEmbed As NotesEmbeddedObject
          
        Set doc=session.DocumentContext
         fileNames=Evaluate("@AttachmentNames",doc)  '获取文档所有附件名称
         filePath=session.GetEnvironmentString("Directory")  '环境变量
         If(Isarray(fileNames)) Then
                 Forall fileName In fileNames
                       filePath=filePath+"\"+fileName
                         Set objEmbed=doc.GetAttachment(filename)
                       Call objEmbed.ExtractFile(filePath)'将文档中的附件导出
                   Call objEmbed.Remove() '删除文档中的附件
           End Forall
       End If
       Exit Sub

MsgError:
        Msgbox "Error:"+Error$+" onLine:"+Cstr(Erl)
End Sub