NOTESEXCEL 转换源码

NOTES<--------------->EXCEL 转换源码
1.notes--->excel:＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋

Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As Notesview
Dim doc As Notesdocument． Dim excelapplication As Variant
Dim excelworkbook As Variant
Dim excelsheet As Variant
Dim i As Integer
Dim uvcols As Integer
Dim selection As Variant
'path=session.GetEnvironmentString ("D:",True)
'gzpath=path+"/"+"test.xls"
Set excelapplication=CreateObject("Excel.Application")
excelapplication.statusbar="正在创建工作表，请稍等....."
excelapplication.Visible=True
'==================
'excelapplication.excel.open(gzpath)
excelapplication.Workbooks.Add
excelapplication.referencestyle=2
Set excelsheet=excelapplication.Workbooks(1).worksheets(1)
excelsheet.name="notes export"
Dim rows As Integer
Dim cols As Integer
Dim maxcols As Integer
Dim fieldname As String
Dim fitem As NotesItem
rows=1
cols=1
Set db=session.CurrentDatabase
Set view=db.GetView ("注册表视图")
uvcols=Ubound(view.Columns)
For x=0 To Ubound(view.Columns)
excelapplication.statusbar="正在创建单元格，请稍等....."
If view.Columns(x).IsHidden=False Then
If view.Columns(x).title<>"" Then
'excelsheet.Cells(1,1).value="姓名"
'excelsheet.Cells(1,2).value="年龄"
excelsheet.Cells(rows,cols).value=view.Columns(x).Title
cols=cols+1
End If
End If
Next
maxcols=cols-1
Set doc=view.GetFirstdocument． rows=2
cols=1
While Not(doc Is Nothing)
For x=0 To Ubound(view.Columns)
excelapplication.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)
excelsheet.Cells(rows,cols).value=fitem.Text
cols=cols+1
End If
End If
Next
rows=rows+1
cols=1
Set doc=view.GetNextdocument．nbsp(doc)
Wend
With excelapplication.worksheets(1)
.pagesetup.orientation=2
.pagesetup.centerheader="report_confidential"
.pagesetup.rightfooter="page &P"&Chr$(13) &"Date:&D"
.pagesetup.CenterFooter=""
End With
excelapplication.referencestyle=1
excelapplication.range("A1").Select
excelapplication.statusbar="数据导入完成。"
excelsheet.PageSetup.PrintGridlines=True
'excelworkbook.printout
'excelworkbook.SaveAs("d:/test.xls")
'excelworkbook.Save
excelapplication.Quit
Set excelapplication=Nothing
End Sub