Lotus 技术点之导出
a) 导出到excel中
Sub Click(Source As Button)
Dim s As New notessession
Dim db As notesdatabase
Dim view As notesview
Dim dc As notesdocumentcollection
Dim doc As notesdocument
Dim vcols As Variant
Dim uvcols As Integer
Set db = s.currentdatabase
Set dc = db.unprocesseddocuments
Set view = db.getview("当前视图的名称 ")
uvcols=Ubound(view.columns)
Dim xlapp As Variant
Dim xlsheet As Variant
'创建一个Excel对象
Set xlapp=createobject("Excel.application")
xlapp.statusbar = "正在创建工作表，请稍等......"
xlapp.visible = True
'添加工作薄
xlapp.workbooks.add
xlapp.referencestyle = 2
Set xlsheet = xlapp.workbooks(1).worksheets(1)
'为工作表命名
xlsheet.name = "notes export"
Dim rows As Integer
rows = 1
Dim cols As Integer
cols = 1
Dim maxcols As Integer
For x=0 To Ubound(view.columns)
xlapp.statusbar = "正在创建单元格，请稍等...... "
If view.columns(x).IsHidden = False Then
If view.columns(x).title<>"" Then
xlsheet.cells(rows,cols).value = view.columns(x).title
cols = cols + 1
End If
End If
Next
maxcols=cols-1
Set doc=dc.getfirstdocument
Dim fieldname As String
Dim fitem As notesitem
rows=2
cols=1
Do While Not(doc Is Nothing)
For x=0 To Ubound(view.columns)
xlapp.statusbar="正在从Notes中引入数据，请稍等......"
If view.columns(x).IsHidden=False Then
If view.columns(x).title<>"" Then
fieldname = view.columns(x).itemname
Set fitem = doc.getfirstitem(fieldname)
xlsheet.cells(rows, cols).value = fitem.text
cols = cols +1
End If
End If
Next
rows = rows+1
cols = 1
Set doc= dc.getnextdocument(doc)
Loop
%REM
xlApp.Row s("1:1").select
xlApp.Selection.Font.Bold=True
xlApp.Range(xls heet.cells(1,1),xlsheet.Cells(rows,maxcols)).Select
xlApp.Selection.Fon t.Name="Arial"
xlApp.Selection.Font.Size=9
xlApp.Selcetion.Col umns.Autofit
%END REM
With xlapp.worksheets(1)
.pagesetup.orientation = 2
.pagesetup.centerheader = "report _ confidential"
.pagesetup.rightfooter = "page &P" & Chr$(13) & "Date:&D"
.pagesetup.CenterFooter = ""
End With
xlapp.referencestyle = 1
xlapp.range("A1").Select
xlapp.statusbar = "数据导入完成。"
End Sub
b) 以表格形式导出
Sub Initialize
%REM
功能：导出内部数据到Excel中去
作者：xxx
最后修改时间：
%END REM
On Error Goto unknowErr
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim tempdoc As NotesDocument
Dim strTemp As String
Dim strPath As String
If session.CurrentDatabase.FilePath=session.CurrentDatabase.FileName Then
strPath=""
Else
strPath=Strleftback(session.CurrentDatabase.FilePath,session.CurrentDatabase.FileName)
End If
Set db=New NotesDatabase("",strPath & "db_StaffInformation.nsf")
Set view=db.GetView("hvpersonInfo")
Print {Content-disposition:attachment; filename=data.xls}
Print {<table border="1">}
Print {<tr>}
Print {<td>工号</td>}
Print {<td>姓名</td>}
Print {<td>性别</td>}
Print {<td>单位名称</td>}
Print {<td>职位</td>}
Print {<td>办公地点</td>}
Print {<td>办公电话</td>}
Print {<td>移动电话</td>}
Print {<td>传真</td>}
Print {<td>IP地址</td>}
Print {<td>邮政编码</td>}
Print {<td>电子邮件</td>}
Print {<td>联系地址</td>}
Print {</tr>}
'填写数据
Set tempDoc=view.GetFirstDocument
While Not tempDoc Is Nothing
Print {<tr>}
'工号
Print {<td >} & Cstr(tempDoc.EmployeeID(0)) & {</td>}
'姓名
Dim neibuName As NotesName
Set neibuName=New NotesName(tempDoc.myname(0))
Print {<td >} & neibuName.Common & {</td>}
Print {<td >} & tempDoc.Sex(0) & {</td>}
'工作单文
If neibuName.OrgUnit1<>"" Then
strTemp=neibuName.OrgUnit1
End If
If neibuName.OrgUnit2<>"" Then
strTemp=strTemp & "/" & neibuName.OrgUnit2
End If
If neibuName.OrgUnit3<>"" Then
strTemp=strTemp & "/" & neibuName.OrgUnit3
End If
If neibuName.OrgUnit4<>"" Then
strTemp=strTemp & "/" & neibuName.OrgUnit4
End If
Print {<td >} & strTemp & {</td>}
'职务
If tempDoc.JobTitle(0)="1" Then
strTemp="员工"
End If
If tempDoc.JobTitle(0)="2" Then
strTemp="业务主管"
End If
If tempDoc.JobTitle(0)="3" Then
strTemp="副经理"
End If
If tempDoc.JobTitle(0)="4" Then
strTemp="部门经理"
End If
If tempDoc.JobTitle(0)="5" Then
strTemp="分管领导"
End If
If tempDoc.JobTitle(0)="6" Then
strTemp="总经理"
End If
If tempDoc.JobTitle(0)="7" Then
strTemp="董事长"
End If
Print {<td >} & strTemp & {</td>}
Print {<td >} & tempDoc.Location(0) & {</td>}
Print {<td >} & tempDoc.OfficePhoneNumber(0) & {</td>}
Print {<td >} & tempDoc.CellPhoneNumber(0) & {</td>}
Print {<td >} & tempDoc.OfficeFAXPhoneNumber(0) & {</td>}
Print {<td >} & tempDoc.IP(0) & {</td>}
Print {<td >} & tempDoc.OfficeZIP(0) & {</td>}
Print {<td >} & tempDoc.InternetAddress(0) & {</td>}
Print {<td >} & tempDoc.OfficeStreetAddress(0) & {</td>}
Print {</tr>}
Set tempDoc=view.GetNextDocument(tempDoc)
Wend
Print {</table>}
Exit Sub
unknowErr:
Messagebox "错误行：" & Erl & "错误信息：" & Error
End Sub
