domino导出excel方法

1、简单方法：
问题automation服务器不能创建对象
解决办法：如果javascript脚本中报这个错误是因为IE的安全设置不允许运行未标记为安全的activeX控件 更改IE的安全设置，把相应的选项打开即可。

Sub Initialize
Dim s As New NotesSession
Dim curdoc As NotesDocument
Dim curdb As NotesDatabase
Dim vw As NotesView
Dim doc As NotesDocument
Dim et As NotesViewEntry
Dim i
i=3
Set curdb=s.CurrentDatabase
Set vw=curdb.GetView("UmSafetyInfo")
Set doc=vw.GetFirstDocument
'Dim x As Variant
'tempstr=|@name([OU2];'|+curdoc.remote_user(0)+|')|
'x=Evaluate(tempstr)
'Msgbox x(0)
Print |

|
End Sub



2、常用方法：

Sub Initialize
On Error GoTo errormsg
Dim session As New NotesSession
Dim cdoc As NotesDocument
Dim doc As NotesDocument
D

im view As NotesView
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Set db=session.currentdatabase
Set cdoc=session.documentcontext
Set view=db.GetView("UmSafetyInfo")

tempDir=session.GetEnvironmentString("Directory", True) '获取环境变量，将代理权限设低
If InStr(tempDir, "/") <> 0 And Right(tempDir, 1) <> "/" Then
tempDir = tempDir & "/domino/html/"
End If
If InStr(tempDir, "\") <> 0 And Right(tempDir, 1) <> "\" Then
tempDir = tempDir & "\domino\html\"
End If
filename="中国电信四川公司安全管理人员数据库.xls"
filepath=tempDir & filename

Print ||
If Dir(filePath)<>"" Then Kill filePath
Dim excelapplication As Variant
Dim excelworkbook As Variant
Dim excelsheet As Variant
Dim i As Integer
Dim uvcols As Integer
Dim selection As Variant
Set excelapplication=CreateObject("Excel.Application")
excelapplication.statusbar="正在创建工作表，请稍等.."
excelapplication.Visible=False
Set excelWorkbook = excelApplication.Workbooks.Add
Set excelSheet = excelWorkbook.Worksheets("sheet1")
https://www.360docs.net/doc/222668581.html,="中国电信四川公司安全管理人员数据库" '工作表的名字

Dim rows As Integer
Dim cols As Integer
Dim maxcols As Integer
Dim fieldname As String
Dim fitem As NotesItem
rows=1
excelapplication.statusbar="正在创建单元格，请稍等.."
excelapplication.Range(excelsheet.Cells(rows, 1), excelsheet.Cells

(rows, 12)).Merge '设置title跨几行显示

rows=2
excelsheet.Rows(2).Font.Bold=1
excelsheet.Rows(2)https://www.360docs.net/doc/222668581.html,="宋体"
excelsheet.Range("A1","L1").MergeCells = 1
excelsheet.Cells(1,1).Value="中国电信四川公司安全管理人员数据库"
excelsheet.Range("A1","A1").HorizontalAlignment = 3
REM 设置风格
excelsheet.Rows(1).Font.Bold=1
excelsheet.Rows(1)https://www.360docs.net/doc/222668581.html,="黑体"
excelsheet.Rows(1).Font.Size=16
excelsheet.Rows(2).Font.Size=9
excelsheet.Columns(1).ColumnWidth = 25
excelsheet.Columns(2).HorizontalAlignment=3
excelsheet.Columns(3).HorizontalAlignment=3
excelsheet.Columns(4).HorizontalAlignment=3
excelsheet.Columns(4).ColumnWidth = 13.63
excelsheet.Columns(5).HorizontalAlignment=3
excelsheet.Columns(6).HorizontalAlignment=3
excelsheet.Columns(6).ColumnWidth = 25
excelsheet.Columns(7).HorizontalAlignment=3
excelsheet.Columns(7).ColumnWidth = 13.63

excelsheet.Cells(rows,1).value="单位名称"
excelsheet.Cells(rows,2).value="分管领导"
excelsheet.Cells(rows,3).value="姓名"
excelsheet.Cells(rows,4).value="安办职务"
excelsheet.Cells(rows,5).value="性别"
excelsheet.Cells(rows,6).value="出生年月"
excelsheet.Cells(rows,7).value="学历"
excelsheet.Cells(rows,8).value="岗位名称"
excelsheet.Cells(rows,9).value="是否兼职"
excelsheet.Cells(rows,10).value="兼职名称"
excelsheet.Cells(rows,11).value="联系电话"
excelsheet.Ce

lls(rows,12).value="手机"

cols=12
maxcols=cols-1
excelapplication.statusbar="正在导出数据，请稍等.."
Set doc=view.Getfirstdocument()
While Not doc Is Nothing
rows=rows+1
excelsheet.Cells(rows,1).value=doc.UmDeptName(0)
excelsheet.Cells(rows,2).value=doc.UmManageLeader(0)
excelsheet.Cells(rows,3).value=doc.UmUserName(0)
excelsheet.Cells(rows,4).value=doc.UmWorking(0)
excelsheet.Cells(rows,5).value=doc.UmSex(0)
excelsheet.Cells(rows,6).value=doc.UmBirtyday(0)
excelsheet.Cells(rows,7).value=doc.UmEducation(0)
excelsheet.Cells(rows,8).value=doc.UmWorkName(0)
excelsheet.Cells(rows,9).value=doc.UmIsFullTime(0)
excelsheet.Cells(rows,10).value=doc.UmPartTimeWork(0)
excelsheet.Cells(rows,11).value=doc.UmTel(0)
excelsheet.Cells(rows,12).value=doc.UmMoblie(0)
Set doc = view.GetNextDocument(doc)
Wend
excelapplication.statusbar="数据导入完成。"
excelWorkbook.SaveAs(filePath)
excelApplication.Quit
Set excelapplication=Nothing
Print ""
Exit Sub

errormsg:
MsgBox "OutExcel Error:" & Str(Erl) & " " & Error
End Sub