Lotus数据导入(Excel)

 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,"提示"