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