就是保存时把同类文档的条项换成excel的列，然后把所有的同类文档综合成一个excel文档？
小葱一根 回复于：2005-02-23 21:36:00
引用：原帖由 "aoeiu"]就是保存时把同类文档的条项换成excel的列，然后把所有的同类文档综合成一个excel文档？
发表：
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．nbsp
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．nbsp
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
2.excel-->;notes＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim item As NotesItem
Dim files As Variant
Dim schar As String
Dim excelApplication As Variant
Dim excelWorkbook As Variant
Dim excelsheet As Variant
Dim i As Integer
Set db = session.CurrentDatabase
Set view = db.GetView( "ExcelRegister" )
files=workspace.OpenFileDialog (False,"选择引入数据文件","Excel file|*.xls","c:")
If files(0)="" Then
Exit Sub
Else
Set excelApplication=CreateObject("Excel.Application")
Set excelWorkbook =excelApplication.Workbooks.Open(files)
Set excelsheet=excelWorkbook.Worksheets(1)
i=2
stemp=excelSheet.Cells(i,1).value
Do Until Cstr(stemp)=""
Set cpdoc=New Notesdocument．db)
cpdoc.form="Excel_notes注册表"
cpdoc.lx=excelsheet.Cells(i,1).value
stemp=excelSheet.Cells(i,1).value
stemp2=excelSheet.Cells(i,2).value
cpdoc.NameExcel=stemp
cpdoc.AgeExcel=stemp2
i=i+1
Call cpdoc.save(True,False)
Call workspace.ViewRefresh
Loop
excelWorkbook.close(False)
excelApplication.Quit
Set excelApplication=Nothing
End If
End Sub
================================
另一个 Notes 引出到Excel的例子
分类: Lotus Script
内容： Export view to Excel (R4)
Floris Spruijt
24 Oct 2001, Rating 4.00 (out of 5)
This agent will export a defined view to excel as is, and will nicely align everything to the left. 2 separate settings need to be adjusted in order for the export to work (From Notes KB Article):
1. Open registry, go to key:
HKEY_LOCAL_MACHINESystemCurrentControlSetcontrolNlsLocale and change the top key (Default) to: 00000409
2. Change regional settings to: English (United States)
Create Agent, paste code in Initialize event, and you are done.
PS: don't forget to modify the commented lines. (as views or title may not suit you)
Code
Sub Initialize
Dim s As New notessession
Dim db As notesdatabase
Dim doc As notesdocument
Dim view As notesview
Dim xlapp As Variant
Dim xlsheet As Variant
Set db = s.currentdatabase
Set view = db.getview("Export") '< The view from where the export should come from.
Dim vcols As Variant
vcols = view.columns
Set xlapp = createobject ("Excel.application")
xlApp.StatusBar = "Importing Notes Data"
xlapp.visible = True
xlapp.workbooks.add
xlapp.referencestyle = 2
Set xlsheet = xlapp.workbooks(1).worksheets(1)
xlsheet.name = "Database Report" '<Sheet title
Dim rows As Integer
rows = 1
Dim cols As Integer
cols = 1
Dim maxcols As Integer
For x = 0 To Ubound(vcols)
If vcols (x).ishidden = False Then
If vcols (x).title <>; "" Then
xlsheet.cells (rows,cols).value = vcols(x).title
cols = cols + 1
End If
End If
Next
maxcols = cols -1
Set doc = view.GetFirstDocument
Dim fieldname As String
Dim fitem As notesitem
rows = 2
cols = 1
Do While Not (doc Is Nothing)
For x = 0 To Ubound (vcols)
fieldname = vcols(x).itemname
Set fitem = doc.GetFirstItem(fieldname)
xlsheet.cells(rows, cols).value=fitem.text
cols = cols + 1
Next
rows = rows + 1
cols = 1
xlApp.StatusBar = "Importing Notes Data - Document " & rows - 1
Set doc = view.getnextdocument (doc)
Loop
'Set header entries
xlapp.rows("1:1").select
xlapp.selection.font.name = "Arial"
xlapp.selection.font.size = 10
xlapp.selection.font.bold = True
'Set data entries
xlapp.range(xlsheet.cells(2,1), xlsheet.cells(rows,maxcols)).select
xlapp.selection.font.name = "Arial"
xlapp.selection.font.size = 9
xlapp.selection.HorizontalAlignment = -4131
xlapp.selection.sort (xlsheet.cells(1,1))
'Set all entries
xlapp.range(xlsheet.cells(1,1), xlsheet.cells(rows,maxcols)).select
xlapp.selection.columns.autofit
With xlapp.worksheets(1)
.pagesetup.orientation = 2
.pagesetup.printtitlerows = "$1:$1"
End With
xlapp.referencestyle = 1
xlapp.range("a1").select
xlApp.StatusBar = "Importing Notes Data - Completed"
End Sub
==========================
作个代理读多个文裆
自己多试试 :em19:
aoeiu 回复于：2005-02-24 11:39:27
你怎么搜到的?我搜遍网站只找到一个什么c/s下执行的save data--->;--....--->; :(
非常感谢 :)
qingzhou 回复于：2005-03-15 20:50:05
加精鼓励。。。
|
