使用lotusscript抽取文档中的附件并从文档中删除 源码

Dim createDir As Boolean
 
 '获取附件名称
 Dim attachName As Variant
 '获得文档附件对象
 Dim attachObj As NotesEmbeddedObject
 '文档附件存放顶级目录
 Dim docAttachDir As String
 '当前的年份目录
 Dim curYearDir As String
 '当前流程名称目录
 Dim curProcessNameDir As String
 '当前文档ID目录
 Dim curDocumentIdDir As String
 '定义附件存放路径
 Dim dominoPath,mainPath,secondPath As String
 
 Dim curYearEvaluateDir As Variant
 
 
 '先做是否具有附件的判断，如果文档不存在附件
 '即不做抽取 直接跳出该过程
 
 '获取附件名称列表
 attachName=Evaluate( |@AttachmentNames|,curDoc)
 ForAll item In attachName
  '获取附件对象
  Set attachObj=curDoc.Getattachment(item)
  'lotusscript问题，当文档只有一个附件和文档不含附件 其上标ubound都是0
  '所以无法只通过UBound()>0来判断附件数量
  If attachObj Is Nothing And UBound(attachName)=0 Then
   MsgBox "#############此文档是没有附件的，不做任何处理，附件抽取结束！！！！###############"
    '跳出附件抽取过程
    GoTo index
  End If
 End ForAll
 MsgBox "---------------进入附件抽取过程----------------------------"
 '获得domino的服务器路径
 dominoPath=session.GetEnvironmentString("Directory",True)
 'MsgBox "domino服务主路径========="&dominoPath
 '定义二级路径的根目录
 docAttachDir="attachDirWf"
 curProcessNameDir=curDoc.ProcessOS(0)
 '获取当前年份
 curYearEvaluateDir=Evaluate( |@Text(@Year(@Today))|)
 curYearDir=curYearEvaluateDir(0)
 'MsgBox "当前年份目录============="&curYearDir
 '获取当前文档id
 curDocumentIdDir=curDoc.Universalid
 secondPath=docAttachDir+"/"+curYearDir+"/"+curProcessNameDir+"/"+curDocumentIdDir+"/"
 'MsgBox "附件存放的二级路径为================="&secondPath
 
 mainPath=dominoPath+"/domino/html/"+secondPath
 
 Dim curProcessNameDirPath As String
 
 curProcessNameDirPath=dominoPath+"/domino/html/"
 
 MsgBox "mainPath="&mainPath
 
 If Dir$(curProcessNameDirPath,16)="" Then
  
  MsgBox "文件夹不存在"
 Else
  MsgBox "文件夹已经存在"
 End If
 
 'Java调用
 Set mySession=New Javasession()
 Set myClass = mySession.Getclass("text")
 Set myObject = myClass.CreateObject()
 
 Dim attachNames As String
 '创建文件夹
 createDir= myObject.createTempDirectory(mainPath)
 If createDir=True Then
  '获得文档中的附件对象
 attachName=Evaluate( |@AttachmentNames|,curDoc)
 If(IsArray(attachName)) Then
  'MsgBox UBound(attachName)
  'If(UBound(attachName)>0) Then
  ForAll item In attachName
  MsgBox "附件名称为======="&item
   Set attachObj=curDoc.Getattachment(item)
   'If attachObj Is Nothing Then
   ' MsgBox "is null"
   ' GoTo index
   'Else
   '判断是否是word控件，是则不抽取，
    If attachObj.Name<>curDoc.TANGER_OCX_filename(0) Then 'word控件不抽取
     'MsgBox "附件is not null"
     'MsgBox "抽取"+attachObj.Name+"附件开始"
     Call attachObj.Extractfile(mainPath+attachObj.Name)
     'MsgBox "抽取"+attachObj.Name+"附件结束"
     '向表单写入附件全路径
     '主附件存单独的域
     'MsgBox attachObj.Name
     'MsgBox curDoc.mainFileName(0)+"****************************"
     If attachObj.Name=curDoc.mainFileName(0) And curDoc.mainFilePath(0)="" Then
      curDoc.mainFilePath=secondPath+attachObj.Name
     Else
      MsgBox "判断是否有word附件"
      If curDoc.mainFileName(0)="" And attachObj.Name=Replace(curDoc.TANGER_OCX_filename(0),".doc",".pdf") Then
       curDoc.mainFilePath=secondPath+attachObj.Name
       curDoc.mainFileName=attachObj.Name
      Else
       attachNames=secondPath+attachObj.Name+";"+attachNames
      End If
      
     End If
    End If
   'End If
  End ForAll 
  
 '移除附件
 Dim object As Variant 
 Dim names As String
 ForAll item In curDoc.Items
  If(UCase(item.name) = UCase("$file")) Then
   names = item.values(0)
   If names<>"" Then
    'MsgBox "移除附件"+names+"开始"
    Set object = curDoc.Getattachment(names)
    Call object.remove()
    'MsgBox "移除附件"+names+"结束"
   End If
   MsgBox names
  End If
 End ForAll
 
 
 End If
 End If
 'MsgBox "-------------attachNames-------------------"&attachNames
 Call curDoc.Replaceitemvalue("docFilePath", attachNames)
 Call curDoc.Save(True, True)
 MsgBox "-------------docFilePath----------------------------"&curDoc.docFilePath(0)
index:
 MsgBox "======Function FunAfterJobComplete End======"