[B/S]使用vb插入记录到lotus notes数据库中

解决思路:VB中传入参数,并调用Notes数据库中的代理来实现。
1 VB中运行代理
例如:要创建一份文档表单名称Student,四个域Name、Sex、Age、Memo,
域值分别zhangsan、M、26、hello,则

strUrl="http://127.0.0.1/domcfg.nsf/WriteRecord?OpenAgent"
strPara="&DB=oa/system.nsf"
strPost="&Field=Form,Name,Sex,Age,Memo&Value=Student,zhangsan,M,26,hello"
strRet=DoPost(strUrl,strPara,strPost)
Msgbox "运行结果:" & strRet

Function DoPost(strUrl As String, Optional strPara As String, Optional strPost As String) As String
    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
    Call xmlHttp.Open("POST", strUrl + strPara, False)
    Call xmlHttp.Send(strPost)
   
    DoPost = xmlHttp.responseXML.documentElement.Text
End Function

2 创建文档WriteRecord代理:
Sub Initialize
 On Error Goto Alert
 Dim ss As New NotesSession
 Dim db As NotesDatabase
 Dim doc As NotesDocument
 Dim dbTarget As NotesDatabase
 Dim docTarget As NotesDocument
 Dim strPara As String
 
 Set db = ss.CurrentDatabase
 Set doc = ss.DocumentContext
 
 '数据库
 strPara = GetParaValue(doc.Query_String_Decoded(0),"Db","")
 If strPara = "" Then
  Set dbTarget = db
 Else
  Set dbTarget = New NotesDatabase("",strPara)
  If Not(dbTarget.IsOpen) Then
   PrintXML "操作失败"
   Exit Sub
  End If
 End If
 
 Dim i As Integer
 '表单域及域值,传入数据使用","做为分隔符
 Dim varField As Variant
 Dim varValue As Variant
 strPara = GetParaValue(doc.Request_Content(0),"Field","")
 varField = Split(strPara,",")
 strPara = GetParaValue(doc.Request_Content(0),"Value","")
 varValue = Split(strPara,",")
 '新建文档
 If varField(0)<>"" Then
  Set docTarget = New NotesDocument(dbTarget)
  For i=0 To Ubound(varField)
   Call docTarget.ReplaceItemValue(varField(i),varValue(i))
  Next
  Call docTarget.Save(True,True)
  PrintXML "操作成功"
 Else
  PrintXML "获取参数失败"
 End If
 Exit Sub
Alert:
 Msgbox "Error:" & Error & "    Erl:" & Erl &  "    Err:" & Err
 PrintXML "操作失败"
End Sub

Function GetParaValue(Byval strQuery As String,Byval strName As String,Byval strDefault As String) As String
 Dim strPara As String
 Dim intPos As Integer
 intPos=Instr(Lcase$(strQuery),"&" & Lcase(strName) & "=")
 If intPos>0 Then
  strPara=Mid$(strQuery ,intPos+2+Len(strName))
  If Instr(strPara,"&")>0 Then
   strPara=Strleft(strPara,"&")
  End If
  GetParaValue=Trim$(strPara)
 Else
  GetParaValue=strDefault
 End If
End Function

Sub PrintXML(Byval strXML As String)
 Print "content-type:text/xml; charset=gb2312"
 Print "<?xml version=""1.0"" encoding=""gb2312""?>"
 Print "<center>" & strXML & "</center>"
End Sub

3 说明
(1)DoPost函数中的参数格式需要同代理保持一致
(2)示例中增加传入Db参数,若参数为空则表示在当前数据库中创建文档
(3)示例处理中将文档所属表单做为参数传入,通过Field中的Form及对应的值来指定
(4)示例中只处理各数据值为文本的情况,读者可通过增加传入区别数据类型的参数以解决该问题

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值