Excel导入到notes中
Dim session As New notessession
Dim db As notesdatabase
Dim view As notesview
Dim doc As notesdocument
Dim tempdoc As notesdocument
Dim w As New notesuiworkspace
Dim authorsItem As NotesItem
Dim collection As NotesDocumentCollection
Dim v(0) As String
Dim r As Integer
Dim xlapp As Variant
Dim xlbook As Variant
Dim xlsheet As Variant
Set db = session.CurrentDatabase
Set collection = db.UnprocessedDocuments
Set doc = collection.GetFirstDocument()
Eval = Evaluate(|@IsNotMember("[Administrator]";@UserRoles)|,doc) '用户执行操作时的判断权限
If Eval(0) = 1 Then
Msgbox "对不起,您无权使用此权限!请与管理员联系",0+16,"提示"
Exit Sub
End If
REM 导入数据时,不采用绝对的路径和文档名称
Dim files As Variant
files = w.OpenFileDialog(True, "打开Excel文档","", "D:")
Set db = session.currentdatabase
If Isempty(files(0)) Then
Exit Sub
Else
Set xlApp = CreateObject("Excel.Application") '创建Excel应用类
xlApp.Visible = False '设置Excel为不可见
Set xlBook = xlApp.Workbooks.Open(files(0)) '打开Excel工作薄
REM 设置打开Excel的第几个工作表
num =Cstr(Inputbox$("请问您想导入的工作表为第几个?"))
If num = "" Then
Exit Sub
End If
a = Cint(num)
Set XlSheet = xlBook.Worksheets(a) '打开Excel工作表
End If
r = 4
While Not Cstr(xlsheet.cells(r,1).value) = ""
Set doc = New NotesDocument(db)
doc.Form = "shenqing"
doc.date_1 = xlsheet.cells(r,1).value '申请日期
doc.Deft = xlsheet.cells(r,2).value '申请部门
doc.Text_5 = xlsheet.cells(r,3).value '申请工作区域
doc.Text_1 = xlsheet.cells(r,4).value '来访人员姓名
doc.CheckBox_2 = xlsheet.cells(r,5).value '来访人员有效证件名称
doc.Text_2 = xlsheet.cells(r,6).value '来访人员有效证件号码
doc.Text_3 = xlsheet.cells(r,7).value '来访人员公司名称
doc.sdate = xlsheet.cells(r,8).value '工作有效期限
doc.Text_9 = xlsheet.cells(r,9).value '发放证件编号
r = r+1
Print r
REM "编号的生成"
DateKey1 = Cstr(Format(doc.date_1(0),"yyyy")) '取原始数据中的年
DateKey2 = Cstr(Format(doc.date_1(0),"mm")) '取原始数据中的月
DateKey3 = Cstr(Cint(DateKey1))+"-"+Cstr(Cint(DateKey2))
DateKey = DateKey1+DateKey2
Dim Numview As NotesView
Dim Numdoc As NotesDocument
Dim vc As NotesViewEntryCollection
Dim entry As NotesViewEntry
Set Numview = db.GetView( "AllByNumber" )
Call Numview.refresh
Set vc = Numview.GetAllEntriesByKey(DateKey3,True)
doc.import = 1 '设置表单数据倒入时的参数
doc.date = "" '使数据导入后,打开表单时不显示表单创建的时间
If vc.count =0 Then
doc.Number = DateKey+"001"
Else
Set entry = vc.GetFirstEntry()
Set Numdoc = entry.Document
K = Cint(Right(Numdoc.Number(0),3))+1
If K <10 Then
Key1 = "00"+Cstr(K)
Elseif K<100 Then
Key1 = "0"+Cstr(K)
Else
Key1 = Cstr(K)
End If
doc.Number = DateKey+Key1
End If
doc.SaveOptions = "1"
Call doc.save(False,True)
If doc.Text_9(0) <> "" Then '流程参数设置
doc.lei = "已完成"
doc.actionnumber = "-1"
doc.statu = 2
doc.saveoptions = "1"
Call doc.save(False,True)
End If
Wend
Call xlbook.close(True)
Call xlapp.quit
Msgbox"导入完毕",0+32,"提示"
Lotus数据导入(Excel)
最新推荐文章于 2017-02-17 14:00:45 发布