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 |
<script language=javascript>
var xls = new ActiveXObject ( "Excel.Application" );
//xls.visible = "false";
var xlBook = xls.Workbooks.Add;
var xlsheet = xlBook.Worksheets(1);
xls.Cells.Select;
xlsheet.Cells(2,1).Value="部门";
xlsheet.Cells(2,2).Value="姓名";
xlsheet.Cells(2,3).Value="分机";
xlsheet.Cells(2,4).Value="移动电话";
xlsheet.Cells(2,5).Value="手机小号";
xlsheet.Cells(2,6).Value="电子邮件";
xlsheet.Cells(2,7).Value="直拨电话";
xlsheet.Rows(2).Font.Bold=1;
xlsheet.Rows(2).Font.Name="宋体";
xlsheet.Range("A1","G1").MergeCells = 1;
xlsheet.Cells(1,1).Value="某某公司";
xlsheet.Range("A1","A1").HorizontalAlignment = 3
//xlsheet.Range("A2","G2").ColorIndex = 48
xlsheet.Rows(1).Font.Bold=1;
xlsheet.Rows(1).Font.Name="黑体";
xlsheet.Rows(1).Font.Size=16;
xlsheet.Rows(2).Font.Size=9;
xlsheet.Columns(1).ColumnWidth = 25
xlsheet.Columns(2).HorizontalAlignment=3
xlsheet.Columns(3).HorizontalAlignment=3
xlsheet.Columns(4).HorizontalAlignment=3
xlsheet.Columns(4).ColumnWidth = 13.63
xlsheet.Columns(5).HorizontalAlignment=3
xlsheet.Columns(6).HorizontalAlignment=3
xlsheet.Columns(6).ColumnWidth = 25
xlsheet.Columns(7).HorizontalAlignment=3
xlsheet.Columns(7).ColumnWidth = 13.63
|
Do While Not (doc Is Nothing)
Print |xlsheet.Rows(|+i|).Font.Size=9;|
Print |xlsheet.Cells(| +i+|,1).Value='|+"Mid(doc.department(0),1)"+|';|
Print |xlsheet.Cells(| +i+|,2).Value='|+"doc.name(0)"+|';|
Print |xlsheet.Cells(| +i+|,3).Value='|+"Cstr(doc.OfficeTelExt(0))"+|';|
Print |xlsheet.Cells(| +i+|,4).Value='|+"Cstr(doc.Cellphone(0))"+|';|
Print |xlsheet.Cells(| +i+|,5).Value='|+"Cstr(doc.CellphoneLittle(0))"+|';|
Print |xlsheet.Cells(| +i+|,6).Value='|+"doc.Email(0)"+|';|
Print |xlsheet.Cells(| +i+|,7).Value='|+"Cstr(doc.OfficeTel(0))"+|';|
i=i+1
Set doc=vw.GetNextDocument(doc)
Loop
Print |
xlBook.SaveAs("c:\\通讯录.xls");
xlBook.Close ();
xls.Quit();
xls=null;
alert("已经保存在C盘 通讯录.xls文件中");
Temp=window.location.href.toLowerCase();
Temp=Temp.substring(0,Temp.lastIndexOf(".nsf")+5)+"UmSafetyInfo?openview";
window.location=Temp;
</script>
|
End Sub
2、常用方法：
Sub Initialize
On Error GoTo errormsg
Dim session As New NotesSession
Dim cdoc As NotesDocument
Dim doc As NotesDocument
Dim 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 |<script language="javascript">alert(|+filepath+|)</script>|
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")
excelsheet.name="中国电信四川公司安全管理人员数据库" '工作表的名字
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).Font.Name="宋体"
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).Font.Name="黑体"
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.Cells(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 "<script>location.href='/"+ filename +"'</script>"
Exit Sub
errormsg:
MsgBox "OutExcel Error:" & Str(Erl) & " " & Error
End Sub