您的位置:首页 > 其它

将视图数据引出EXCEL文件的LOTUSSCRIPT程序设计

2004-07-31 21:35 148 查看
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 Mood As String

Dim selection As Variant

On Error Goto Err1

Set excelApplication = CreateObject("Excel.Application")
Set excelWorkbook = excelApplication.Workbooks.Add
Set excelSheet = excelWorkbook.Worksheets("Sheet1")
'定义excel的列值
excelSheet.Cells(1,1).value = "序号"
excelSheet.Cells(1,2).value = "项目编码"
excelSheet.Cells(1,3).value = "项目型号"
excelSheet.Cells(1,4).value = "项目描述"
excelSheet.Cells(1,5).value = "维护人员"
excelSheet.Cells(1,6).value = "备注"

i = 1
Set db = session.CurrentDatabase
'获取视图
Set view = db.GetView("项目清单")
Set doc = view.GetFirstdocument.nbsp

While Not(doc Is Nothing)
i = i + 1
'定义域名
excelSheet.Cells(i,1).value = i-1
excelSheet.Cells(i,2).value = doc.P_Code(0)
excelSheet.Cells(i,3).value = doc.P_Name(0)
excelSheet.Cells(i,4).value = doc.P_Desc(0)
Print "引出第" & I & "个记录成功,请稍候!"

Set doc = view.GetNextdocument.doc)
Wend

excelWorkbook.SaveAs("c:/项目清单.xls")

Msgbox "报表引出成功,请到C盘根目录下查找!",48,"提示"

excelApplication.Quit
Set excelApplication = Nothing

Exit Sub

Err1:

Msgbox "发生错误,请与管理员联系!",48,"提示"
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: