之前写的导入Excel数据到Domino数据库中,但是是在Notes客户端执行的,现改进一下,在页面上操作把文件上传到服务器指定文件夹中,然后程序读取这个文件:
第一步,在表单中加入文件上载按钮:
![](https://i-blog.csdnimg.cn/blog_migrate/992278759f718df35fe3d7cb5e055da2.jpeg)
在按钮事件中加入导入的代理:
@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
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
转载于:https://blog.51cto.com/niuniu59310396/302180