求关于lotusscript实现所有数据导入word并把它导出来的代码,该如何解决
求关于lotusscript实现所有数据导入word并把它导出来的代码
问题描述:用lotusscript写关于导出word,且把整张单的所有数据都导进去,包括附件也导入到WORD里的具体代码。
------解决方案--------------------
Class CWord
'当前用户会话
s As NotesSession
'当前数据库对象
currDb As NotesDatabase
'对象是否有效
isValid As Variant
'文件保存相对路径
FilePath As String
'Word模版保存目录
WordModelPath As String
'Word文件保存目录
WordDocPath As String
'路径分隔符
sep As String
'析构函数中是否自动删除Word应用程序
bAutoExitWordApp As Variant
'在自动删除Word应用程序时是否保存Word文档
bSaveChanges As Variant
'Word 应用程序对象
Public wordApp As Variant
fileNameList List As String
filePathList List As String
Function CreatedWordDocByWordModelDoc(wordModelDoc As NotesDocument,sWordModelNameItemName As String,sRTItemNameContainsWordModel As String,wordDocObject As Variant) As Variant
CreatedWordDocByWordModelDoc=False
If isValid Then
Dim item As Variant
'word 应用程序 Documents 集合
Dim documents As Variant
'Word模板名
Dim wordModelName As String
'Word模板路径名(含文件名)
Dim wordModelFilePath As String
Dim key As String
If wordModelDoc.HasItem(sWordModelNameItemName) Then
Set item=wordModelDoc.GetFirstItem(sWordModelNameItemName)
If Trim(item.Text)<>"" Then key=item.Text
End If
wordModelFilePath=GetFilePathByKey(key)
If ""=wordModelFilePath Then
Dim rtItem As Variant
Dim wordModelFileName As String
'提取以 sRTItemNameContainsWordModel 的值为名的RTF域中的第一个附件(Word模板)
If wordModelDoc.HasItem(sRTItemNameContainsWordModel) Then
Set rtItem =wordModelDoc.GetFirstItem(sRTItemNameContainsWordModel)
If ( rtItem.Type = RICHTEXT ) Then
Forall o In rtItem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
wordModelFileName = o.Source
key=wordModelFileName
wordModelFilePath=GetFilePathByKey(key)
If ""=wordModelFilePath Then
wordModelFilePath = WordModelPath$ & wordModelFileName
fileNameList(key) = wordModelFileName
filePathList(key) = wordModelFilePath
Call o.ExtractFile( wordModelFilePath )
Set o = Nothing
End If
Exit Forall
End If
End Forall
End If
End If
End If
If ""<>wordModelFilePath Then
Set documents = wordApp.Documents
'生成新的Word文档
Set wordDocObject = documents.Add(wordModelFilePath)
If Not wordDocObject Is Nothing Then CreatedWordDocByWordModelDoc=True
End If
End If
End Function
'把Notes文档转换为Word文档
Function ConvertNotesToWord(toConvertedDoc As NotesDocument,wordDocObject As Variant,bookMarkFieldNamesOdd List As String) As Variant
On Error Goto LblErrorHandler
'初步判断所传参数的正确性
If (wordDocObject Is Nothing) Or (toConvertedDoc Is Nothing) Then
ConvertNotesToWord = False
Exit Function
End If
'书签名
Dim bookMark As String
Dim vMicroResult As Variant
Forall e In bookMarkFieldNamesOdd
bookMark = Listtag(e)
If wordDocObject.Bookmarks.Exists(bookMark) Then
wordDocObject.Bookmarks(bookMark).Select
If Instr(e,"Byval#")>0 Then
wordApp.Selection.TypeText(Strright(e,"Byval#"))
Elseif Instr(e,"ByFormula#")>0 Then
vMicroResult = Evaluate(Strright(e,"ByFormula#"),toConvertedDoc)
wordApp.Selection.TypeText(vMicroResult(0))
Elseif Trim(e)="*" Then
Else
问题描述:用lotusscript写关于导出word,且把整张单的所有数据都导进去,包括附件也导入到WORD里的具体代码。
------解决方案--------------------
Class CWord
'当前用户会话
s As NotesSession
'当前数据库对象
currDb As NotesDatabase
'对象是否有效
isValid As Variant
'文件保存相对路径
FilePath As String
'Word模版保存目录
WordModelPath As String
'Word文件保存目录
WordDocPath As String
'路径分隔符
sep As String
'析构函数中是否自动删除Word应用程序
bAutoExitWordApp As Variant
'在自动删除Word应用程序时是否保存Word文档
bSaveChanges As Variant
'Word 应用程序对象
Public wordApp As Variant
fileNameList List As String
filePathList List As String
Function CreatedWordDocByWordModelDoc(wordModelDoc As NotesDocument,sWordModelNameItemName As String,sRTItemNameContainsWordModel As String,wordDocObject As Variant) As Variant
CreatedWordDocByWordModelDoc=False
If isValid Then
Dim item As Variant
'word 应用程序 Documents 集合
Dim documents As Variant
'Word模板名
Dim wordModelName As String
'Word模板路径名(含文件名)
Dim wordModelFilePath As String
Dim key As String
If wordModelDoc.HasItem(sWordModelNameItemName) Then
Set item=wordModelDoc.GetFirstItem(sWordModelNameItemName)
If Trim(item.Text)<>"" Then key=item.Text
End If
wordModelFilePath=GetFilePathByKey(key)
If ""=wordModelFilePath Then
Dim rtItem As Variant
Dim wordModelFileName As String
'提取以 sRTItemNameContainsWordModel 的值为名的RTF域中的第一个附件(Word模板)
If wordModelDoc.HasItem(sRTItemNameContainsWordModel) Then
Set rtItem =wordModelDoc.GetFirstItem(sRTItemNameContainsWordModel)
If ( rtItem.Type = RICHTEXT ) Then
Forall o In rtItem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
wordModelFileName = o.Source
key=wordModelFileName
wordModelFilePath=GetFilePathByKey(key)
If ""=wordModelFilePath Then
wordModelFilePath = WordModelPath$ & wordModelFileName
fileNameList(key) = wordModelFileName
filePathList(key) = wordModelFilePath
Call o.ExtractFile( wordModelFilePath )
Set o = Nothing
End If
Exit Forall
End If
End Forall
End If
End If
End If
If ""<>wordModelFilePath Then
Set documents = wordApp.Documents
'生成新的Word文档
Set wordDocObject = documents.Add(wordModelFilePath)
If Not wordDocObject Is Nothing Then CreatedWordDocByWordModelDoc=True
End If
End If
End Function
'把Notes文档转换为Word文档
Function ConvertNotesToWord(toConvertedDoc As NotesDocument,wordDocObject As Variant,bookMarkFieldNamesOdd List As String) As Variant
On Error Goto LblErrorHandler
'初步判断所传参数的正确性
If (wordDocObject Is Nothing) Or (toConvertedDoc Is Nothing) Then
ConvertNotesToWord = False
Exit Function
End If
'书签名
Dim bookMark As String
Dim vMicroResult As Variant
Forall e In bookMarkFieldNamesOdd
bookMark = Listtag(e)
If wordDocObject.Bookmarks.Exists(bookMark) Then
wordDocObject.Bookmarks(bookMark).Select
If Instr(e,"Byval#")>0 Then
wordApp.Selection.TypeText(Strright(e,"Byval#"))
Elseif Instr(e,"ByFormula#")>0 Then
vMicroResult = Evaluate(Strright(e,"ByFormula#"),toConvertedDoc)
wordApp.Selection.TypeText(vMicroResult(0))
Elseif Trim(e)="*" Then
Else