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