[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)示例中只处理各数据值为文本的情况，读者可通过增加传入区别数据类型的参数以解决该问题