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

   2)、Set doc=dc.Getfirstdocument()
 While Not doc Is Nothing
  'Call doc.Replaceitemvalue("resName","newValue")
  Set item =doc.Getfirstitem("yu")
  While Not item Is Nothing
     ForAll resitems In doc.Itemsv(0)
        resitems="newVlaue"
     End ForAll
     doc.name= doc.Itemsv(0)
     Set item =doc.getnextitem(item)
  Wend
  Set doc=dc.getnextdocument(doc)
 Wend
8、拷贝域
         Set item =doc.Getitemvalue("name")
  call item.Copyitemtodocument(doc, "name")
         call doc.save(true,false)
      Call doc1.Copyallitems(doc2,true)  ‘替换所有的
9、删除指定的域：
     1)、 For j=1 To dc.count
   Set item=doc.Getitemvalue("name")
   While Not item Is  Nothing
    Call item.Remove()
    Call doc.Save(true,false)
   Wend
  Set doc=dc.Getnthdocument(j)
     Next
     2)、For j=1 To dc.count  
  While Not doc.Hasitem("name")
    Call doc.Removeitem("name")
    Call doc.Save(True,false)
  Wend 
   Set doc=dc.Getnthdocument(j)   
 Next
10、RTF文本域的输出：
 Set item=doc.GetFirstItem("RtfYU")
 MsgBox item.Text
11、在代理中使用公式：