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
發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章