Sub Click(Source As Button)
On Error Goto p
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim s As New NotesSession
Dim db As NotesDatabase
Dim ajDC As NotesDocumentCollection
Dim ajDoc As NotesDocument
Dim larq As String '立案日期
Dim formula As String
Const path2Save = "E:\立案统计报表" '存储路径
Dim ygBuff As String '原告信息
Dim bgBuff As String '被告信息
Dim mcArray As Variant
Dim dwArray As Variant '地位
Dim dhArray As Variant '电话
Dim rowBegin As Integer
Dim ii As Integer
Dim xlsApp As Variant 'Excel对象
Set xlsApp = CreateObject("Excel.application")
If Not(xlsApp Is Nothing) Then
'在这个 Excel 文件当中添加一个 Sheet
xlsApp.Workbooks.Add
xlsApp.Visible = True
ii = 1
rowBegin = 1
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 1).Value = "序号"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 2).Value = "案号"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 3).Value = "案件类型"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 4).Value = "原告信息"
xlsApp.Workbooks(1).Worksheets( 1 ).Cells( rowBegin , 5).Value = "被告信息"
REM 导出数据至Excel
Set uidoc = ws.CurrentDocument
larq = Format(uidoc.FieldGetText("LARQ"),"yyyy年mm月dd日")
Set db = s.CurrentDatabase
formula = "(Form = 'Mostly')& (LARQ='"+larq+"')"
Set ajDC = db.Search(formula,Nothing,0)
Set ajDoc = ajDC.GetFirstDocument
While Not(ajDoc Is Nothing)
ygBuff = ""
bgBuff = ""
mcArray = Split(ajDoc.MC(0),"|")
dhArray = Split(ajDoc.LXDH(0),"|")
If(ajDoc.HasItem("DW"))Then
dwArray = Split(ajDoc.DW(0),"|")
For index = 0 To Ubound(dwArray)
If("原告" = dwArray(index) Or "申请人" = dwArray(index))Then
ygBuff = ygBuff + mcArray(index) + "##" + Trim(dhArray(index)) + ";"
Else
If("被告" = dwArray(index) Or "被申请人" = dwArray(index))Then
bgBuff = bgBuff + mcArray(index) + "##" + Trim(dhArray(index)) + ";"
End If
End If
Next
Else
For index = 0 To Ubound(mcArray)
bgBuff = bgBuff + mcArray(index) + "##" + Trim(dhArray(index)) + ";"
Next
End If
rowBegin = ii + 1
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 1).Value = Cstr(ii)
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 2).Value = ajDoc.AH(0)
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 3).Value = ajDoc.ajlx(0)
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 4).Value = ygBuff
xlsApp.Workbooks(1).Worksheets( 1 ).Cells(rowBegin , 5).Value = bgBuff
Set ajDoc = ajDC.GetNextDocument(ajDoc)
ii = ii + 1
Wend
xlsApp.Workbooks(1).Worksheets(1).Columns("A:E").EntireColumn.AutoFit
If(Dir(path2Save,16) = "")Then '检查目录是否已经存在
Mkdir(path2Save)
End If
xlsApp.ActiveWorkbook.SaveAs( path2Save+"\"+larq+".xls")
'关闭资源
xlsApp.Quit
'资源释放
Set xlsApp = Nothing
'Msgbox("报表已经生成!")
'打开报表
ws.URLOpen(path2Save+"\"+larq+".xls")
End If
Exit Sub
p:
Msgbox(Erl())
End Sub
分享到:
相关推荐
在domino下,nsf例库,用代理并附详细介绍实现了提取Excel内容的功能
lotus domino CS Excel导出.txt
lotus Domino BS开发 lotusscript print动态导出excel
lotus domino CS 导出选择的excel.docx
Lotus_导出到Office_Excel_的函数的完整版本 包含B/S和C/S ,已经经过测试,直接使用。
有前端的js导出到Excel,可是这个导出需要加信任站点,有些用户就是娇,不想动手,就弄了个后台代理导出到Excel
lotus Domino BS开发 lotusscript导出excel方法一
lotus Domino BS开发 lotusscript导出excel样式说明
lotus Domino BS开发 通过java 代理导出excel.doc
lotus Domino BS开发 Excel 导入导出使用lotusscritp代理、java代理实现
在notes端点击按钮开始对该视图的数据以excel形式进行导出,并将文档中的附件放置在以每个文档ID为文件夹的下面。本资源给出的是数据库文档,和说明该功能的Word文档。
CS开发常用功能-从Excel导入与导出(收集了很多代码)
SMExport 可以从 TDataSet 或者 TDBGrid 或其他 VCL 控件...或者导出数据到文本文件、HTML、XML、MS Excel、MS Word、PDF、MS Access、SQL-script、Lotus 1-2-3、Quattro、SYLK、DIF、LDAP DIF 和其他格式。
1.1.2 Lotus 1-2-3 1.1.3 Quattro Pro 1.1.4 Microsoft Excel 1.2 Excel 对开发人员的重要性 1.3 Excel在Microsoft 战略中的角色 第2章 Excel概述 2.1 关于对象 2.2 工作簿 2.2.1 工作表 2.2.2 ...
将LeanStorage数据导出为电子表格格式 支持的格式 文件类型 文件扩展名 描述 xlsx .xlsx Excel 2007+ XML格式 csv .csv 逗号分隔值 html .html HTML文件 xlsm .xlsm Excel 2007+宏XML格式 xlsb .xlsb ...
1. MS Excel spreadsheet (directly without OLE/DDE) 2. text delimited file 3. text fixed width file 4. XML file 5. HTML file 6. MS Access database 7. MS Word document 8. Lotus 1-2-3 spreadsheet 9. ...
V2.0版修正了打开某些库文件报错的问题,完善了导出功能,能够将库中的所有文档域信息导出到EXCEL并自动分离出附件保存在本机上。 本软件的开发和调试环境为Winodws XP 和Windows 2003 SERVER,32位系统,如果在...
可以进行数据库之间的数据导出导入,,,,,LOTUS NOTES SQL EXCEL 等等,,,,,,,,,,
支持Excel,PDF数据导出。支持Vue,ElementUI的独立前端。支持MySQL,MariaDB和PostgreSQL数据库。支持图片功能。请部署在Tomcat9的webapps目录下。欢迎使用。 项目地址:https://gitee.com/jerryshensjf/Lotus