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======"
'获取附件名称
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======"