LS代码导入Excel数据到Domino数据库[C/S]

新建一代理,在Notes客户端运行此代理:
Sub Initialize    
On Error Goto errhandle
    
Set F = New f_default
    
Msgbox "开始。。。。"
Dim ws As New NotesUIWorkspace
Dim ss As New NotesSession    
Dim db As NotesDatabase    
Dim files As Variant    
Dim schar As String    
Dim doc As NotesDocument    
Dim excelapplication
Dim i,sheet
Set db = ss.CurrentDatabase
files = ws.openfiledialog( False, "请选择要导入的Excel文件", "Excel file/*.xls")
sheeet = 1
If Not( Isempty(files)) Then '如果用户选择了文件,或者输入了文件名,那么就开始准备打开excel文件。
     Set excelapplication = createobject( "excel.application")
     Set excelworkbook = excelapplication.workbooks.open(files)
     If excelworkbook Is Nothing Then '如果未找到文件,则退出
     excelapplication.quit
     Exit Sub
     End If
     Set excelsheet = excelworkbook.worksheets(1)
    i = 2 '从第二行开始读取'一个sheet里面所有记录循环
     Do Until Cstr(excelsheet.cells(i,1).value) =""
     Set doc = New NotesDocument(db)
     doc.Form = "f_XCPKFLX"     '表单名
    doc.MingCheng = "" + excelsheet.cells(i,1).value + ""
     'doc.jiaohuodanhao = excelsheet.cells(i,2).value '交货单号
     'doc.yifuyunfei = excelsheet.cells(i,3).value '已付运费
     'doc.kaifeisuozaidi = excelsheet.cells(i,4).value '开票所在地
     doc.SYS_SUBMITDATE = Cstr(Now())
        
     doc.Creater = "CN=admin/O=org"
        
     doc.Admin_SYS = "HR管理员"
     Dim item As NotesItem    
     Set item = doc.GetFirstItem( "Admin_SYS")    
     item.AppendToTextList( "CN=admin/O=org")
     item.AppendToTextList( "工作门户系统管理员群组")
     item.AppendToTextList( "工作门户系统管理员群组")
     item.AppendToTextList( "系统管理员")
     Call F.SetItemProperty(doc, "Admin_SYS", "R") '设置权限
        
     doc.AllEditors = "*"
     Call F.SetItemProperty(doc, "AllEditors", "R")
        
     doc.Replicate_SYS = "LocalDomainServers"
     Call F.SetItemProperty(doc, "Replicate_SYS", "R")
        
     doc.SYSTEM= "*"
     Call F.SetItemProperty(doc, "SYSTEM", "R") 'Read
     doc.SYS_SYSTEM= "*"    
     Call F.SetItemProperty(doc, "SYS_SYSTEM", "R")    
        
     Call doc.save( True, False) '保存
     i=i+1
     Loop
    excelworkbook.close( False)
    excelapplication.quit
     Set excelapplication = Nothing
End If
    
Msgbox "完成!"
    
    
Exit Sub
    
errhandle:
Call F.printerrmsg(doc, "Initialize")
Exit Sub
End Sub

本文出自 “笨笨牛” 博客,谢绝转载!

你可能感兴趣的:(数据库,职场,excel导入,休闲,domino)