导出到Excel

 

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

   以表格形式导出

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