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