代理中代码
Sub Initialize
On Error GoTo errHandler
Dim session As New NotesSession
Dim db As New NotesDatabase("","")
Dim view As NotesView
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
Set db = session.Currentdatabase
Set view = db.GetView("通讯录")
Set vc = view.AllEntries
Dim ddir As String
ddir = session.GetEnvironmentString("Directory",True) & "\domino\html\"
Dim fn As String
fn = ddir+"公司通讯录.xls"
Print(fn)
Dim xlApp As Variant
Dim xlWorkBook As Variant
Dim xlSheet As Variant
Dim myVersion As String
Dim row As Integer
Set xlApp = createObject("excel.application")
xlApp.visible = False
Select Case Val(xlApp.application.Version)
Case 5
myVersion = "5.0"
Case 7
myVersion = "95"
Case 8
myVersion = "97"
Case 9
myVersion = "2000"
Case 10
myVersion = "2002"
Case 11
myVersion = "2003"
Case 12
myVersion = "2007"
Case 14
myVersion = "2010"
Case Else
myVersion = "版本不明"
End Select
Dim numL As String
Set xlWorkBook = xlApp.WorkBooks.Add
Dim pdoc As NotesDocument
Set xlSheet = xlWorkBook.Sheets(1)
'xlSheet.name = Month(doc.datTJ(0))
With xlSheet
.Rows(1).font.size=20
.Rows(2).font.size=12
.Rows(3).font.size=12
.Rows(1).font.Bold=True
.Rows(2).font.Bold=True
.Rows(3).font.Bold=True
.Rows(4).font.Bold=True
.Rows(1).HorizontalAlignment=3
.Rows(1).RowHeight=27
.Rows(2).HorizontalAlignment=3
.Rows(2).RowHeight=18.75
.Rows(3).HorizontalAlignment=3
.Rows(3).RowHeight=12.75
.Cells(4,1).HorizontalAlignment=3
.Cells(4,2).HorizontalAlignment=3
.Cells(4,3).HorizontalAlignment=3
.Cells(4,4).HorizontalAlignment=3
.Cells(4,5).HorizontalAlignment=3
.Cells(4,6).HorizontalAlignment=3
.Cells(4,7).HorizontalAlignment=3
.Cells(4,1).font.Bold=True
.Cells(4,2).font.Bold=True
.Cells(4,3).font.Bold=True
.Cells(4,4).font.Bold=True
.Cells(4,5).font.Bold=True
.Cells(4,6).font.Bold=True
.Cells(4,7).font.Bold=True
row = 5
Dim txtDep As String
Set entry = vc.GetFirstEntry
While Not(entry Is Nothing)
If(entry.ColumnValues(0) = "") Then
.Cells(row,1) = entry.ColumnValues(1)
.cells(row,2) = entry.ColumnValues(2)
.cells(row,3) = entry.ColumnValues(3)
.cells(row,4) = entry.ColumnValues(4)
.cells(row,5) = entry.ColumnValues(5)
.Cells(row,6) = entry.ColumnValues(6)
.cells(row,7) = entry.ColumnValues(7)
Else
If(txtDep = "" Or txtDep<>entry.ColumnValues(0)) Then
.Cells(row,1) = entry.ColumnValues(0)
txtDep = entry.ColumnValues(0)
.Range(.Cells(row,1),.Cells(row,7)).merge(False)
.cells(row,1).HorizontalAlignment=-4131
.Cells(row,1).font.Bold=True
Else
row = row - 1
End If
row = row + 1
.Cells(row,1) = entry.ColumnValues(1)
.cells(row,2) = entry.ColumnValues(2)
.cells(row,3) = entry.ColumnValues(3)
.cells(row,4) = entry.ColumnValues(4)
.cells(row,5) = entry.ColumnValues(5)
.Cells(row,6) = entry.ColumnValues(6)
.cells(row,7) = entry.ColumnValues(7)
End If
.Rows(row).font.size=12
.Rows(row).HorizontalAlignment=3
'.cells(row,2).HorizontalAlignment=-4131
row = row + 1
Set Entry = vc.GetNextEntry(Entry)
Wend
.Columns(7).ColumnWidth = 21.38
.Columns(6).ColumnWidth = 9.13
.Columns(5).ColumnWidth = 15.5
.Columns(4).ColumnWidth = 12.13
.Columns(3).ColumnWidth = 12.13
.Columns(2).ColumnWidth = 12.13
.Columns(1).ColumnWidth = 13.25
.Range(.Cells(4,1),.Cells(row - 1,7)).Borders.LineStyle = 1
.Range(.Cells(1,7),.Cells(row - 1,7)).Borders(10).Weight = -4138 '10左
.Range(.Cells(4,1),.Cells(4,7)).Borders(8).Weight = -4138
.Range(.Cells(row-1,1),.Cells(row-1,7)).Borders(9).Weight = -4138 '9下
End With
If myVersion="2007" Or myVersion="2010" Then
Call xlWorkbook.saveas(fn,56,"","",False,False)
Else
Call xlWorkbook.saveas(fn)
End If
getOut:
Exit Sub
errHandler:
MsgBox Error$ & " (" & Err & " at line " & Erl & ")",,"Error"
Resume getOut
End Sub
按钮代码
var db:NotesDatabase = session.getCurrentDatabase();
var agent = db.getAgent("excel");
agent.runOnServer();
链接代码
<xp:scriptBlock id="scriptBlock1">
<a href="/公司通讯录.xls">下载</a>
</xp:scriptBlock>