雪人与晶晶的平凡生活

将excel中的数据导入Domino中

2006年11月20日星期一

上传excel文件到服务器上（可通过先上传到文档再解压到服务器指定目录）
打开excel，读取内容到新建的文档中

实现方法：在服务器上安装excel，直接操作excel对象，范例如文后所附（略有删节）

实现方法：通过pio或jexcel等开源jar包对excel文件进行操作

Sub Initialize
On Error Goto errHandle
On Error Resume Next

Dim Session As NotesSession
Dim Db As NotesDatabase
Dim Doc As NotesDocument
Dim NewDoc As NotesDocument

Set Session=New NotesSession
Set Db=Session.CurrentDatabase
Set Doc=Session.DocumentContext

Dim strFileName As String
strFileName=Doc.FtpPath(0) & Doc.FileName(0)

'///启动Excel
Dim ExcelApp As Variant
Dim ExcelWorkBooks As Variant
Dim WorkBooks As Variant
Dim WorkBook As Variant
Dim sheet As Variant

Set ExcelApp=CreateObject("Excel.Application")
If ExcelApp Is Nothing Then
Msgbox "无法启动Microsfot Excel，请检查你的系统是否已经安装！",0+64,"提示信息"
Exit Sub
End If
ExcelApp.Visible=False '是否为可见

Set ExcelWorkBooks=ExcelApp.Workbooks.Open(strFileName)
ExcelWorkBooks.Activate
Set WorkBook=ExcelApp.ActiveWorkbook
If WorkBook Is Nothing Then
Msgbox "无法启动Excel，请检查是否安装。"
Exit Sub
End If
Set sheet=WorkBook.Sheets(1)

Dim i As Integer
Dim itm As NotesItem
Dim nExcelCol(11) As Integer
Dim strEnable(11) As String
For i=0 To 4
Set itm=Doc.GetFirstItem("ExcelCol_" & i)
nExcelCol(i)=Val(itm.Values(0))
Set itm=Doc.GetFirstItem("Enable_" & i)
strEnable(i)=itm.Values(0)
Next

Dim nStart As Integer
Dim nEnd As Integer
Dim strType As String
nStart=Val(Doc.RowStart(0))
nEnd=Val(Doc.RowEnd(0))

While (sheet.Cells(nStart,1).Value <> "")
Set NewDoc=New NotesDocument(Db)
NewDoc.Form="Address"
NewDoc.Author=Doc.Author(0)

If strEnable(0)="1" Then
strType=sheet.Cells(nStart, nExcelCol(0)).Value
NewDoc.AddressType_show=strType '分类
End If
If strEnable(1)="1" Then
NewDoc.PeopleName=Cstr(sheet.Cells(nStart, nExcelCol(1)).Value)'姓名
End If
If strEnable(2)="1" Then
NewDoc.WorkPhone=Cstr(sheet.Cells(nStart, nExcelCol(2)).Value)'办公电话
End If
If strEnable(3)="1" Then
NewDoc.MobilePhone=Cstr(sheet.Cells(nStart, nExcelCol(3)).Value)'手机
End If
If strEnable(4)="1" Then
NewDoc.HomePhone=Cstr(sheet.Cells(nStart, nExcelCol(4)).Value)'住宅电话
End If

nStart=nStart+1
Wend
…………
Call ExcelApp.Quit

Set sheet=Nothing
Set WorkBook=Nothing
Set WorkBooks=Nothing
Set ExcelWorkBooks=Nothing
Set ExcelApp=Nothing

Kill strFileName

Print |＜script language=“javascript”＞|
Print |alert('您已成功引入Excel表的数据!');|
Print |window.close();|
Print |＜／ｓｃｒｉｐｔ＞|

Exit Sub
errHandle:
Msgbox "错误：" & Error$(Err) & "错误行：" & Erl

Call ExcelApp.Quit
Set sheet=Nothing
Set WorkBook=Nothing
Set WorkBooks=Nothing
Set ExcelWorkBooks=Nothing
Set ExcelApp=Nothing
End Sub

标签： Lotus Domino