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

之前写的导入Excel数据到Domino数据库中，但是是在Notes客户端执行的，现改进一下，在页面上操作把文件上传到服务器指定文件夹中，然后程序读取这个文件：

第一步，在表单中加入文件上载按钮：

在按钮事件中加入导入的代理：

@Command([ToolsRunMacro];"NIUNIUExcelImportInWeb")

 

第二步，修改代理NIUNIUExcelImportInWeb。修改的代理完整代码如下：

  

Sub Initialize
    
On Error Goto errhandle
    
Set F = New f_default
    
Dim session As NotesSession
Set session = New NotesSession
Dim doc As NotesDocument
Set doc = session.DocumentContext
Dim db As NotesDatabase    
Set db = session.CurrentDatabase    
    
    
If doc.HasEmbedded Then
     Dim inputAttachment As NotesEmbeddedObject
     Dim v_files As Variant
    
    v_files = Evaluate(|@ Trim(@ Replace(@AttachmentNames;TANGER_OCX_filename;""))|,doc)
    
     For i = 0 To Ubound(v_files)
     Set inputAttachment = doc.GetAttachment(v_files(i)) '获取文件
     If Not inputAttachment Is Nothing Then
        
         Dim url As String
        url = session.GetEnvironmentString( "Directory", True)     '路径为\domino\data目录
        
         If Dir$(url+ "\AttachmentTemp",16) = "" Then     '判断在url+"\AttachmentTemp"目录是否存在，不存在则值为空，存在则值为AttachmentTemp
         Msgbox "不存在"
         Mkdir url + "\AttachmentTemp" '在url下面创建一个名为AttachmentTemp的文件夹，当然，可以直接把文件放在\domino\data目录下，不用创建
         url = url + "\AttachmentTemp"
         Else
         Msgbox "存在"
         url = url + "\AttachmentTemp"
         End If
        
        
        
        Msgbox "文件存储位置：" + url
        Msgbox "文件名：" + inputAttachment.Name
        
         Call inputAttachment.ExtractFile(url+ "\temp.xls") '将附件存放到指定路径目录下
         'Call inputAttachment.ExtractFile("d:\"+inputAttachment.Name)
         'Call inputAttachment.Remove
        
        Msgbox "导入开始。。。。"
        
         Dim schar As String    
         Dim excelapplication
         Dim m,sheet
        
        sheeet = 1 '表1
         Set excelapplication = createobject( "excel.application")
         Set excelworkbook = excelapplication.workbooks.open(url+ "\temp.xls")
         If excelworkbook Is Nothing Then '如果未找到文件，则退出
         excelapplication.quit
         Exit Sub
         End If
         Set excelsheet = excelworkbook.worksheets(1)
        m = 2 '从第二行开始读取'一个sheet里面所有记录循环
         Do Until Cstr(excelsheet.cells(m,1).value) =""
         Dim doc2 As NotesDocument
         Set doc2 = New NotesDocument(db)
         doc2.Form = "f_YiFuYunFei"     '表单名
         doc2.dingdanhao = "" + excelsheet.cells(m,1).value + ""
         doc2.jiaohuodanhao = "" + excelsheet.cells(m,2).value + "" '交货单号
         doc2.yifuyunfei = "" + excelsheet.cells(m,3).value + "" '已付运费
         doc2.kaifeisuozaidi = "" + excelsheet.cells(m,4).value + "" '开票所在地
         doc2.SYS_SUBMITDATE = Cstr(Now())
         doc2.Creater = "CN=admin/O=org"    
            
         Call doc2.save( True, False) '保存
         m=m+1
         Loop
        excelworkbook.close( False)
        excelapplication.quit
         Set excelapplication = Nothing
        Kill url+ "\temp.xls" '导入完毕后将文件删除
         'Rmdir url '将存放临时文件temp.xls的文件夹删除
        Msgbox "导入完成！"
        Print {<script>alert( "导入完成！");window.location= "v_f_YiFuYunFeiPeiZhi?openform";</script>}        
                                         'Print "[" & F.getCurDBPath(db) & "v_f_YiFuYunFeiPeiZhi?openform]"
     End If
     Next
End If
    
Exit Sub
    
errhandle:
Call F.printerrmsg(doc, "Initialize")
Exit Sub
End Sub

本文出自 “笨笨牛” 博客，谢绝转载！